package Lingua::tlhInganHol::yIghun;

use strict;
use warnings;

use Carp;
use Filter::Simple;

our $VERSION = '20090601';
my $DEBUG;
my $HONOURABLE = 1;

$DB::single=1;

my %numword = ( 0 => q{pagh},
                1 => q{wa'},
                2 => q{cha'},
                3 => q{wej},
                4 => q{loS},
                5 => q{vagh},
                6 => q{jav},
                7 => q{Soch},
                8 => q{chorgh},
                9 => q{Hut},
                10 => q{maH},
                100 => q{vatlh},
                1000 => q{SaD},
                10000 => q{netlh},
                100000 => q{bIp},
                1000000 => q{'uy'},
            );

my %val = reverse %numword;

my $numword = '(?='. join('|',values %numword) . ')';
$numword{unit} = '(?:'. join('|',@numword{0..9}) . ')';

my $number = qr{  $numword
		  (?:($numword{unit})($numword{+1000000}))? [ ]*
                  (?:($numword{unit})($numword{+100000}))? [ ]*
                  (?:($numword{unit})($numword{+10000}))? [ ]*
                  (?:($numword{unit})($numword{+1000}))? [ ]*
                  (?:($numword{unit})($numword{+100}))? [ ]*
                  (?:($numword{unit})($numword{+10}))? [ ]*
                  (?:($numword{unit}?) (?!$numword))? [ ]*
		  (  DoD [ ]* (?:$numword{unit} [ ]+)+ )?
                }xi;

sub to_Terran
{
    return "" unless $_[0];
    my @bits = $_[0] =~ $number or return;
    my @decimals = split /\s+/, ($bits[-1] && $bits[-1] =~ s/^DoD\s*// ? pop @bits : 'pagh');
    my ($value,$unit,$order) = 0;
    $value += $val{$unit||$order&&"wa'"||"pagh"} * $val{$order||"wa'"}
	while ($unit, $order) = splice @bits, 0, 2;
    $order = 0.1;
    foreach $unit (@decimals) {
	    $value += $val{$unit} * $order;
	    $order /= 10;
    }
    return $value;
}

sub from_Terran
{
    my ($number, $decimal) = split /[.]/, $_[0];
    my @decimals = $decimal ? split(//, $decimal) : ();
    my @bits = split //, $number;
    return $numword{0} unless grep $_, @bits;
    my $order = 1;
    my @numwords;
    my $last;
    for (reverse @bits) {
        next unless $_;
        push @numwords, $numword{$_};
        $numwords[-1] .= $numword{$order} if $order > 1;
    }
    continue { $order *= 10 }
    @decimals = map($numword{$_}, @decimals);
    unshift @decimals, 'DoD' if @decimals;
    return join " ", reverse(@numwords), @decimals;
}

sub print_honourably {
	my $handle = ref($_[0]) eq 'GLOB' ? shift : undef;
	@_ = $_ unless @_;
	my $output = join "", map {defined($_) ? $_ : ""} @_;
	# $output =~ s{(\d+)[.](\d+)}
		    # {from_Terran($1).' DoD '.map {from_Terran($_)} split '',$2}e;
	$output =~ s{(\d+(.\d+)?)}{from_Terran($1)}e;
	if ($handle) { print {$handle} $output }
	else         { print $output }
}

sub readline_honourably {
	my $handle = ref($_[0]) eq 'GLOB' ? shift : undef;
	my $input;
	if ($handle) { $input = readline $handle }
	else         { $input = readline }
	return unless defined $input;
	$input =~ s{($number)\s*DoD((\s*$number)+)}
		   {to_Terran($1) . '.' .
		    map {to_Terran($_)} grep /\S/, split /($number)/,$2}e;
	$input =~ s{($number)}{to_Terran($1)}e;
	return $input;
}

my $EOW = qr/(?![a-zA-Z'])/;

sub enqr {
	my $pattern = join '|', @_;
	return qr/((?:$pattern)$EOW)/;
}

sub inqr {
	my $pattern = join '|', @_;
	return qr/($pattern)/;
}

my %n_decl = qw(
	yoS		package	
);
my $n_decl = enqr keys %n_decl;
sub to_decl {
	my ($name, $cmd) = @_;
	return "$cmd->{trans} $name->{trans}";
}

my %sub_decl = qw(
	nab		sub	
);
my $sub_decl = enqr keys %sub_decl;
sub to_sub_decl {
	my ($block, $name, $cmd) = @_;
	return "$cmd->{trans} $name->{trans}" unless $block->{trans};
	return "$cmd->{trans} $block->{trans}" unless $name->{trans};
	return "$cmd->{trans} $name->{trans} $block->{trans}";
}

my %v_usage = qw(
	lo'		use	
	lo'Qo'		no	
);
my $v_usage = enqr keys %v_usage;
sub to_usage {
	my ($name, $cmd) = @_;
	return "$cmd->{trans} $name->{trans}";
}

my %v_go = qw(
	jaH		goto
	yInargh		last	
	yItaH		next 	
	yInIDqa'	redo	
);
my $v_go = enqr keys %v_go;
sub to_go {
	my ($name, $cmd) = @_;
	$name||={trans=>""};
	return "$cmd->{trans} $name->{trans}";
}

my %v_listop = qw(
	mISHa'		sort	
	wIv		grep	
	choH		map	
);
my $v_listop = enqr keys %v_listop;
sub to_listop {
	my ($block, @list) = @_;
	my $op = pop @list;
	return join " ", map("$_->{trans} ", $op, $block),
		join ",", map $_->{trans}, @list;
}


my %v_blockop = qw(
	chov		eval	
	vang		do	
);
my $v_blockop = enqr keys %v_blockop;
sub to_blockop {
	my ($block, $op) = @_;
	return "$op->{trans} $block->{trans}";
}

my %v_match = qw(
	ghov		m	
);
my $v_match = enqr keys %v_match;
sub to_match {
	my ($expr, $pattern, $op) = @_;
	$pattern->{trans} =~ s/^qq?<|>$//g;
	return "$expr->{trans} =~ $op->{trans}<$pattern->{trans}>";
}

my %v_change = qw(
	tam		s	
	mugh		tr	
);
my $v_change = enqr keys %v_change;
sub to_change {
	my ($expr, $becomes, $pattern, $op) = @_;
	$pattern->{trans} =~ s/^qq?<|>$//g;
	$becomes->{trans} =~ s/^qq?<|>$//g;
	return "$expr->{trans} =~ $op->{trans}<$pattern->{trans}><$becomes->{trans}>";
}

my %v_arg0 = qw (
	laD		readline
	chaqpoDmoH	chomp	
	poDmoH		chop	
	HaD		study	
	chImmoH		undef	
	Say'moH		reset	
	mIS		rand	
	juv		length	
	toq'a'		defined	
	rIn'a'		eof	
	ghomneH		wantarray
	mej		exit	
	Hegh		die	
	ghuHmoH		warn	
	pa'Hegh		Carp::croak
	pa'ghuHmoH	Carp::carp
	pongwI'		caller	
	buv		ref	
	Del		stat	
	ghum		alarm	
	mol		dump	
	bogh		fork	
	Qong		sleep	
	loS		wait	
	mach		lc	
	wa'Dichmach	lcfirst	
	tIn		uc	
	wa'DichtIn	ucfirst	
	nargh		quotemeta
);
my $v_arg0 = enqr keys %v_arg0;

my %v_arg1 = qw (
	tlhoch		not	
	noD		reverse		
	HaD		study	
	ja'		tell	
	Such		each	
	lI'a'		exists	
	pong		keys	
	'ar		abs	
	joqtaH		sin	
	joqtaHHa'	cos	
	poD		int	
	maHghurtaH	log	
	lo'Sar		sqrt	
	mIS		rand	
	mIScher		srand	
	mach		lc	
	wa'Dichmach	lcfirst	
	tIn		uc	
	wa'DichtIn	ucfirst	
	nargh		quotemeta
	juv		length	
	sIj		split	
	toq'a'		defined	
	mob		scalar	
	lo'laH		values	
	rIn'a'		eof	
	chov		eval	
	mej		exit	
	Hegh		die	
	ghuHmoH		warn	
	pa'Hegh		Carp::croak
	pa'ghuHmoH	Carp::carp
	pongwI'		caller	
	buv		ref	
	bagh'a'		tied	
	poQ		require	
	ghomchoH	chdir	
	Sach		glob	
	teq		unlink	
	ghomtagh	mkdir	
	ghomteq		rmdir	
	Del		stat	
	ghum		alarm	
	mol		dump	
	tagh		exec	
	Qong		sleep	
	ra'		system	
	loS		wait	
	ghomneH		wantarray
);
my $v_arg1 = enqr keys %v_arg1;
sub to_arg1 {
	my ($arg, $func) = @_;
	$arg ||= {trans=>""};	# handle optional args
	return $arg->{trans}."->$func->{trans}()" if $arg->{object};
	return $func->{trans}."($arg->{trans})";
}

my %v_arg1_da = qw (
	poS		open	
	laD		readline
	bot		flock	
	nup		truncate
	chaqpoDmoH	chomp	
	poDmoH		chop	
	chImmoH		undef	
	Say'moH		reset	
	woD		pop	
	nIH		shift	
	SoQmoH		close	
	Qaw'		delete	
	baghHa'		untie	
);
my $v_arg1_da = enqr keys %v_arg1_da;
sub to_arg1_da {
	my ($arg, $func) = @_;
	$arg ||= {trans=>""};	# handle optional args
	return $arg->{trans}."->$func->{trans}()" if $arg->{object};
	return "$func->{trans} $arg->{trans}" if $arg->{type} =~ /handle$/;
	return $func->{trans}."($arg->{trans})";
}

my %v_arg2 = qw (
	qojHa'		atan2	
	So'		crypt	
	boSHa'		unpack	
	Sam		index	
	naw'choH	chmod	
	pIn'a'choH	chown	
	rar		link	
	neq		rename	
);
my $v_arg2 = enqr keys %v_arg2;
sub to_arg2 {
	my ($arg1, $arg2, $func) = @_;
	return $arg1->{trans}."->$func->{trans}($arg2->{trans})"
		if $arg1->{object};
	return "$func->{trans}($arg1->{trans}, $arg2->{trans})";
}

# my %v_arg2_i = qw (
# );
# my $v_arg2_i = enqr keys %v_arg2_i;
##  sub to_arg2_i {
	# my ($arg1, $arg2, $func) = @_;
	# return "$arg1->{trans} $func->{trans} $arg2->{trans}";
# }

my %v_arg2_da = qw (
	DoQ		bless	
	bot		flock	
);
my $v_arg2_da = enqr keys %v_arg2_da;
sub to_arg2_da {
	my ($arg1, $arg2, $func) = @_;
	return $arg1->{trans}."->$func->{trans}($arg2->{trans})"
		if $arg1->{object};
	return "$func->{trans} $arg1->{trans} ($arg2->{trans})"
		if $arg1->{type} =~ /handle$/;
	return "$func->{trans}($arg1->{trans}, $arg2->{trans})";
}

my %v_arg2_a = qw (
	DIch		[...]
	DIchvo'		[...]
	DIchvaD		[...]
	Suq		{...}
	Suqvo'		{...}
	SuqvaD		{...}
);
my $v_arg2_a = enqr keys %v_arg2_a;
sub to_arg2_a {
	my ($arg1, $arg2, $func) = @_;
	$arg1->{trans} =~ s/^(\$.*)/$1\->/;
	$arg1->{trans} =~ s/^([%@])/\$/;
	die "<<Suq>> yIlo'Qo' <<DIch>> yIlo' jay'"	# Not "Suq"! "DIch"!
		if substr($func->{raw},0,3) eq 'Suq' && $1 eq '@';
	die "<<DIch>> yIlo'Qo' <<Suq>> yIlo' jay'"	# Not "DIch"! "Suq"!
		if substr($func->{raw},0,3) eq 'DIch' && $1 eq '%';
	$func->{trans} =~ s/\Q.../$arg2->{trans}/;

	return "$arg1->{trans}$func->{trans}";
}

my %v_args = qw (
	noD		reverse		
	boS		pack	
	sIj		split	
	muv		join	
	tatlh		return	
	Hegh		die	
	ghuHmoH		warn	
	pa'Hegh		Carp::croak
	pa'ghuHmoH	Carp::carp
	tagh		exec	
	HoH		kill	
	muH		kill
	chot		kill
	bach		kill
	Hiv		kill
	DIS		kill
	jey		kill
);
my $v_args = enqr keys %v_args;
sub to_args {
	my $func = pop @_;
	my $arg1 = shift @_;
	my $args = join(",",map $_->{trans}, @_);
	return $arg1->{trans}."->$func->{trans}($args)"
		if $arg1->{object};
	$args = ",$args" if $args;
	return "$func->{trans}($arg1->{trans}$args)";
}

sub to_args_u {
	my $func = pop @_;
	my $arg1 = shift @_;
	my $args = join(",",map $_->{trans}, @_);
	return $arg1->{trans}."->$func->{trans}($args)"
		if $arg1 && $arg1->{object};
	$args = ",$args" if $args;
	return "$func->{trans}($arg1->{trans}$args)" if $arg1;
	return "$func->{trans}()";
}

sub to_args_ur {
	my $func = pop @_;
	my $arg1 = shift @_;
	my $args = join(",",map $_->{trans}, @_);
	return $arg1->{trans}."->$func->{trans}($args)"
		if $arg1 && $arg1->{object};
	$args = ",$args" if $args;
	return "$func->{trans}->($arg1->{trans}$args)" if $arg1;
	return "$func->{trans}->()";
}

my %v_args_da = qw (
	ghItlh		print	
	lagh		substr	
	yuv		push	
	DuQ		splice	
	poS		open	
	nej		seek	
	bagh		tie	
	jegh		unshift	
);
my $v_args_da = enqr keys %v_args_da;
sub to_args_da {
	my $func = pop @_;
	my $arg1 = shift @_;
	$arg1 ||= tok("","","");
	my $args = join(",",map $_->{trans}, @_);
	return $arg1->{trans}."->$func->{trans}($args)"
		if $arg1->{object};
	return "$func->{trans} $arg1->{trans} ($args)"
		if $arg1->{type} =~ /handle$/;
	$args = ",$args" if $args;
	return "$func->{trans}($arg1->{trans}$args)";
}

my %v_unop = qw (
	HUH		-
);
my $v_unop = enqr keys %v_unop;
sub to_unop {
	my ($arg, $op) = @_;
	return "$op->{trans}$arg->{trans}";
}

my %v_unop_dpre = qw (
	ghur		++
	nup 		--
);
my $v_unop_dpre = enqr keys %v_unop_dpre;
sub to_unop_dpre {
	my ($arg, $op) = @_;
	return "$op->{trans}$arg->{trans}";
}

my %v_unop_dpost = qw (
	ghurQav		++
	nupQav 		--
);
my $v_unop_dpost = enqr keys %v_unop_dpost;
sub to_unop_dpost {
	my ($arg, $op) = @_;
	return "$arg->{trans}$op->{trans}";
}

my %v_binop = qw (
	'ov		cmp	
	chel		+
	chelHa'		-
	wav		/
	HUH		*
	chen		..
	chuv		%
);
my $v_binop = enqr keys %v_binop;

my %v_binop_np = qw (
	logh		x
	je		&&
	joq		||
	pIm'a'		ne	
	rap'a'		eq	
	mI'rap'a'	==
	mI'pIm'a'	!=
);
my $v_binop_np = enqr keys %v_binop_np;

sub to_binop {
	my ($left, $right, $op) = @_;
	return "$left->{trans} $op->{trans} $right->{trans}";
}

my %v_binop_d = qw (
	nob		=
);
my $v_binop_d = enqr keys %v_binop_d;
sub to_binop_d {
	my ($left, $right, $op) = @_;
	return "$left->{trans} $op->{trans} $right->{trans}";
}

my %v_ternop = qw (
	wuq		?:
);
my $v_ternop = enqr keys %v_ternop;
sub to_ternop {
	my ($cond, $iftrue, $iffalse, $op) = @_;
	return "$cond->{trans} ? $iftrue->{trans} : $iffalse->{trans}";
}


my %control = qw(
	teHchugh	if	
	teHchughbe'	unless	
	teHtaHvIS	while	
	teHtaHvISbe'	until	
	tIqel		for	
);
my $control = enqr keys %control;
sub to_control {
	my ($block, $condition, $control) = @_;
	return "$control->{trans} ($condition->{trans}) $block->{trans}";
}

my %s_decl = qw(
	wIj		my	
	meywIj		my	
	pu'wI'		my	
	maj		our	
	meymaj		our	
	pu'ma'		our	
	vam		local	
	meyvam		local	
	pu'vam		local	
);
my $s_decl = inqr keys %s_decl;

my %noun_dat = qw(
	ghochna'	STDOUT
	luSpetna'	STDERR
);
my $noun_dat = inqr keys %noun_dat;

my %noun_acc = qw(
	juH		main	
	'oH		$_
	chevwI'		$/
	natlhwI'	$|
	bIH		@_
);
my $noun_acc = inqr keys %noun_acc;

my %noun_abl = qw(
	mungna'vo'	STDIN	
	De'Daqvo'	DATA	
);
my $noun_abl = inqr keys %noun_abl;

my @stack;
sub tok {
	my %tok;
	@tok{qw(type raw trans)} = @_;
	return \%tok;
}

sub nostop {
	my ($word) = @_;
	$word =~ s/'/Z/g;
	return $word;
}

sub pushtok {
	my ($type, $raw, $trans) = @_;
	print STDERR qq{Treated "$raw" as $type meaning "$trans"\n} if $DEBUG;
	my $object;
	$object = $type = 'dat' if $type eq 'object';
	if ($type eq 'acc' && @stack && $stack[-1]{type} eq 'noun_conj') {
		my $conj = pop @stack;
		my $left = pop @stack;
		push @stack, tok('acc', "$left->{raw} $conj->{raw} $raw",
				 "$left->{trans} $conj->{trans} $trans");
	}
	else {
		push @stack, tok($type, @_[1..$#_]);
	}
	object() if $object;
	# use Data::Dumper 'Dumper';
	# print STDERR Dumper [ \@stack ] if $DEBUG;
	return $stack[-1];
}

sub top {
	return unless @stack and grep $_ eq $stack[-1]{type}, @_;
	pop @stack;
}

sub translate {
	my $raw = join " ", map { ref $_ ? $_->{raw} : $_ } @_;
	my $what = (caller(1))[3];
	$what =~ s/.*:://;
	no strict 'refs';
	my $trans = "to_$what"->(@_);
	return ($raw, $trans);
}

sub decl {
	my ($decl) = @_;
	my $name = top('acc')
		or die "$decl: pong Sambe'!\n" ;	# missing name
	$name->{trans} = nostop($name->{raw});
	$decl = tok('adj',$decl,$n_decl{$decl});
	pushtok('cmd', translate($name,$decl));
}

sub sub_decl {
	my ($decl) = @_;
	die "$decl: pong ngoqghom joq Sambe'!\n"	# missing name or block
		unless @stack;
	my $name = pop @stack;
	my $block;
	if ($name->{type} eq 'block') {
		$block = $name;
		$name  = tok("","","");
	}
	else {
		$block = top('block') || tok("","","");
	}
	$name->{trans} = nostop($name->{raw});
	$decl = tok('verb',$decl,$sub_decl{$decl});
	if ($name->{trans}) { pushtok('cmd', translate($block,$name,$decl)) }
	else 		    { pushtok('acc', translate($block,$name,$decl)) }
}

sub usage {
	my ($use) = @_;
	my $name = top('acc')
		or die "$use: pong Sambe'!\n";		# missing name
	$name->{trans} = $name->{raw};
	$use = tok('verb',$use,$v_usage{$use});
	pushtok('cmd', translate($name,$use));
}

sub go {
	my ($go) = @_;
	my $label = top('acc');
	$label->{trans} = $label->{raw};
	$go = tok('verb',$go,$v_go{$go});
	pushtok('cmd', translate($label,$go));
}

sub listop {
	my ($op) = @_;
	my @list;
	while (@stack) {
		unshift @list, top('acc','block')
			|| die "$op: ngoqghom Sambe'!\n"; # missing codegroup
		last if $list[0]{type} eq 'block';
	}
	$op = tok('verb',$op,$v_listop{$op});
	pushtok('acc', translate(@list,$op));
}

sub blockop {
	my ($op) = @_;
	my $name = top('acc','block')
		or die "$op: ngoqghom Sambe'!\n" ;	# missing codegroup
	$op = tok('verb',$op,$v_blockop{$op});
	pushtok('acc', translate($name,$op));
}

sub match {
	my ($op) = @_;
	my $pattern = top('acc')
		or die "$op: nejwI' Sambe'!\n" ;	# missing probe
	my $expr = top('acc')
		or die "$op: De' Sambe'!\n" ;		# missing data
	$op = tok('verb',$op,$v_match{$op});
	pushtok('acc', translate($expr,$pattern,$op));
}

sub change {
	my ($op) = @_;
	my $becomes = top('acc')
		or die "$op: tamwI' Sambe'!\n" ;	# missing substitution
	my $pattern = top('acc')
		or die "$op: nejwI' Sambe'!\n" ;	# missing probe
	my $expr = top('dat')
		or die "$op: DoS Sambe'!\n" ;		# missing data
	$op = tok('verb',$op,$v_change{$op});
	pushtok('acc', translate($expr,$becomes,$pattern,$op));
}

sub arg1 {
	my ($func) = @_;
	my $arg = top('acc') 
		or $func->{raw} =~ /$v_arg0/
		or die "$func: De' Sambe'!\n" ;        # missing data
	$func = tok('verb',$func,$v_arg1{$func});
	pushtok('acc', translate($arg, $func));
}

sub arg1_da {
	my ($func) = @_;
	my $arg = top('dat','abl','dat_handle','abl_handle') 
		or $func =~ /$v_arg0/
		or die "$func: DoS ghap Hal Sambe'!\n" ;
						# missing target or source
	$func = tok('verb',$func,$v_arg1_da{$func});
	if ($HONOURABLE && $func->{trans} =~ /print|readline/) {
		$func->{trans} =
			"Lingua::tlhInganHol::yIghun::$func->{trans}_honourably";
		if ($arg && $arg->{type} =~ s/_handle$//) {
			$arg->{trans} = '\\*'.$arg->{trans};
		}
	}
	pushtok('acc', translate($arg, $func));
}

sub arg2 {
	my ($func) = @_;
	my $arg2 = top('acc')
		or die "$func: De' cha'DIch Sambe'!\n";	# missing second data
	my $arg1 = top('acc')
		or die "$func: De' wa'DIch Sambe'!\n";	# missing first data
	$func = tok('verb',$func,$v_arg2{$func});
	pushtok('acc', translate($arg1, $arg2, $func));
}

sub arg2_da {
	my ($func) = @_;
	my $arg2 = top('acc')
		or die "$func: De' Sambe'!\n";		# missing data
	my $arg1 = top('dat','abl','dat_handle','abl_handle')
		or die "$func: DoS ghap Hal Sambe'!\n";
						# missing target or source
	$func = tok('verb',$func,$v_arg2_da{$func});
	pushtok('acc', translate($arg1, $arg2, $func));
}

sub arg2_a {	# pure *a*blative
	my ($func) = @_;
	my $arg2 = top('acc')
		or die "$func: De' Sambe'!\n";	# missing data
	my $arg1 = top('abl')
		or die "$func: Hal Sambe'!\n";	# missing source
	$func = tok('verb',$func,$v_arg2_a{$func});
	pushtok($func->{raw} =~ /vaD$/ ? 'dat' :
	        $func->{raw} =~ /vo'$/ ? 'abl' : 'acc',
		translate($arg1, $arg2, $func));
}

sub unop {
	my ($func) = @_;
	my $arg1 = top('acc')
		or die "$func: De' wa'DIch Sambe'!\n";	# missing first arg
	$func = tok('verb',$func,$v_unop{$func});
	pushtok('acc', translate($arg1, $func));
}

sub unop_dpre {
	my ($func) = @_;
	my $arg1 = top('dat')
		or die "$func: DoS Sambe'!\n";		# missing target
	$func = tok('verb',$func,$v_unop_dpre{$func});
	pushtok('dat', translate($arg1,$func));
}

sub unop_dpost {
	my ($func) = @_;
	my $arg1 = top('dat')
		or die "$func: DoS Sambe'!\n";		# missing target
	$func = tok('verb',$func,$v_unop_dpost{$func});
	pushtok('dat', translate($arg1,$func));
}

sub binop {
	my ($func) = @_;
	my $arg2 = top('acc')
		or die "$func: De' cha'DIch Sambe'!\n";	# missing second arg
	my $arg1 = top('acc')
		or die "$func: De' wa'DIch Sambe'!\n";	# missing first arg
	$func = tok('verb',$func,$v_binop{$func}||$v_binop_np{$func});
	pushtok('acc', translate($arg1, $arg2, $func));
}

sub binop_d {
	my ($func) = @_;
	my $arg2 = top('acc','dat')
		or die "$func: De' Sambe'!\n";		# missing data
	my $arg1 = top('dat')
		or die "$func: DoS Sambe'!\n";		# missing target
	$func = tok('verb',$func,$v_binop_d{$func});
	pushtok('dat', translate($arg1, $arg2, $func));
}

sub ternop {
	my ($func) = @_;
	my $iffalse = top('acc')
		or die "$func: vItvaD De' Sambe'!\n";	# missing truth data
	my $iftrue = top('acc')
		or die "$func: nepvaD De' Sambe'!\n";	# missing falsehood data
	my $cond = top('acc')
		or die "$func: wuqwI' Sambe'!\n";	# missing decider
	$func = tok('verb',$func,$v_ternop{$func});
	pushtok('acc', translate($cond, $iftrue, $iffalse, $func));
}

sub args_da {
	my ($func) = @_;
	my @args;
	my $first = 1;
	while (1) {
		my $arg = top('acc','dat','abl_handle','dat_handle') or last;
		unshift @args, $arg;
		last if $arg->{type} eq 'dat';
		last if $first and $arg->{list};
		$first=0;
	}
	$func = tok('verb',$func,$v_args_da{$func});
	if ($HONOURABLE && $func->{trans} =~ /print|readline/) {
		$func->{trans} =
			"Lingua::tlhInganHol::yIghun::$func->{trans}_honourably";
		if (@args && $args[0]{type} =~ s/_handle$//) {
			$args[0]{trans} = '\\*'.$args[0]{trans};
		}
	}
	pushtok('acc', translate(@args, $func));
}

sub args {
	my ($func) = @_;
	my @args;
	my $first = 1;
	while (1) {
		my $arg = top('acc') or last;
		unshift @args, $arg;
		last if $arg->{object};
		last if $first and $arg->{list};
		$first=0;
	}
	$func = tok('verb',$func,$v_args{$func});
	if ($HONOURABLE && $func->{trans} eq 'print') {
		$func->{trans} =
			"Lingua::tlhInganHol::yIghun::$func->{trans}_honourably";
		if (@args && $args[0]{type} =~ s/_handle$//) {
			$args[0]{trans} = '\\*'.$args[0]{trans};
		}
	}
	pushtok('acc', translate(@args, $func));
}

sub args_u {
	my ($func) = @_;
	my @args;
	my $first = 1;
	while (1) {
		my $arg = top('acc','dat') or last;
		unshift @args, $arg;
		last if $first && $arg->{list};
		last if $arg->{object};
		$first = 0;
	}
	$func = tok('verb',(@args>1 ? 'tI' : 'yI').$func,$func);
	pushtok('acc', translate(@args, $func));
}

sub args_ur {
	my ($func) = @_;
	my @args;
	my $first = 1;
	while (1) {
		my $arg = top('acc','dat') or last;
		unshift @args, $arg;
		last if $first && $arg->{list};
		last if $arg->{object};
		$first = 0;
	}
	$func = tok('verb',(@args>1 ? 'tI' : 'yI').$func.'vetlh',"\$$func");
	pushtok('acc', translate(@args, $func));
}

sub control {
	my ($control) = @_;
	my $condition = top('acc','dat') 
		or die "$control: tob Sambe'!\n";	# missing test
	my $block = top('block') 
		or die "$control: ngoqghom Sambe'!\n";	# missing code group
	$control = tok('control',$control,$control{$control});
	pushtok('cmd', translate($block,$condition,$control));
}


my @translation;

sub object {
	die "'e': Doch Sambe'"
		unless @stack && $stack[-1]{type} =~ /^(acc|dat)$/;
	$stack[-1]{raw} .= " 'e'";
	$stack[-1]{object} = 1;
}

sub done {
	my $cmd = top('cmd','acc','dat')
		or die +(@stack ? "<<$stack[-1]{raw}>>Daq: " : "") .
			'rIn pIHbe!';
							# unexpected ending
	$cmd = "$cmd->{trans};\n";
	while (my $conj = top('sent_conj')) {
		my $left = top('cmd','acc','dat')
		    or die +(@stack ? "<<$stack[-1]{raw} $conj>>Daq: " : "") .
		           "ra' PoS pIHbe!";		# unexpected left cmd
		$cmd = "$left->{trans} $conj->{trans} $cmd";
	}
	$translation[-1] .= $cmd;
}

sub startblock {
	# print STDERR qq<Treated "{" as start of block\n> if $DEBUG;
	push @translation, "";
	pushtok('start of block', "{", "{");
}

sub endblock {
	print STDERR qq<Treated "}" as end of block\n> if $DEBUG;
	top('start of block') 
		or @stack and die "betleH HivtaH Sampa' veQ: $stack[0]{raw}\n "
					# garbage found before attacking batleth
		or die "betleH HivtaH Sambe'";
					# missing attacking batleth
	pushtok('block', "{...}", "{".pop(@translation)."}");
}

my %nsuff = ( "vo'"    => 'abl',
	      "vo'Hal" => 'abl_handle',
	      "Hal"    => 'abl_handle',
	      "vaD"    => 'dat',
	      "vaDDoS" => 'dat_handle',
	      "DoS"    => 'dat_handle',
	      "'e'"    => 'object',
	      ""       => 'acc' );
my $nsuff   = qr/${\join"|",reverse sort keys %nsuff}/;

sub startlist {
	pushtok('start of list','(','(');
}

sub endlist {
	my $type = $nsuff{$_[0]};
	print STDERR qq<Treated ")" as end of $type list"\n> if $DEBUG;
	my @args;
	while (1) {
		die "'etlh HivtaH Sambe'" unless @stack;
						# missing attacking sword
		my $arg = pop @stack;
		last if $arg->{type} eq 'start of list';
		unshift @args, $arg;
	}
	my $raw   = join " ", map $_->{raw}, @args;
	my $trans = join ",", map $_->{trans}, @args;

	pushtok($type, "($raw)$_[0]", "($trans)")->{list} = 1;
}

my $sing   = qr/(?:yI)?/;
my $plur   = qr/(?:tI)?/;
my $any    = qr/(?:[yt]I)?/;

my %sigil  = ( "mey" => '@', "pu'" => '%', "" => '$' );
my $type   = qr/${\join"|",reverse sort keys %sigil}/;

my %comp   = ( "tIn"     => '>',   "mach"     => '<',
               "tInbe'"  => '<=',  "machbe'"  => '<',
	       "nung"    => 'lt',  "tlha'"    => 'gt',
	       "nungbe'" => 'ge',  "tlha'be'" => 'le',
	     );
my $comp = inqr keys %comp;

sub greater {
	my ($op) = @_;
	my $arg = top('acc') or die "$op law': DIp $op Sambe'"; # missing noun
	pushtok('greater', "$arg->{raw} $op law'", "$arg->{trans} $comp{$op}");
}

sub lesser {
	my ($op) = @_;
	my $arg = top('acc')
		or die "$op puS: DIp ${op}be' Sambe'!";		# missing noun
	my $greater = top('greater')
		or die "$op puS: <<$op law'>> nung Sambe'!";
						# preceding *op* law missing
	pushtok('acc', "$greater->{raw} $arg->{raw} $op puS",
		"$greater->{trans} $arg->{trans}");
}

# my %conj_h = ( "je"  => '&&',   "joq" => '||' );
my %conj_l = ( "'ej" => 'and',  "qoj" => 'or' );

# my $conj_h = enqr keys %conj_h;
my $conj_l = enqr keys %conj_l;

# sub conj_h {
	# my ($conj) = @_;
	# die "$conj: DIp poS Sambe'!"			# missing noun on left
		# unless @stack && $stack[-1]{type} eq 'acc';
	# pushtok('noun_conj', $conj, $conj_h{$conj});
# }

sub conj_l {
	pushtok('sent_conj', $_[0], $conj_l{$_[0]});
}


FILTER {
	$DEBUG = grep /yIQIj/, @_;
	$HONOURABLE = !grep /tera('|::)nganHol/, @_;
	my $TRANS = grep /yImugh/, @_;
	@stack = ();
	$translation[0] = "";
	pos $_ = 0;
	while (pos $_ < length $_) {
		   /\G\s+(#.*|jay')?/gc	# skip ws, invective, and comments
		or /\G!/gc		and done
		or /\G$conj_l/gc	and conj_l("$1")
		# or /\G$conj_h/gc	and conj_h("$1")
		or /\G($number)/gc	and pushtok('acc',"$1",to_Terran($1))
		or /\G(<<(.*?)>>('e')?)/gc
					and pushtok($3?'object':'acc',"$1",qq{qq<$2>})
		or /\G(<(.*?)>('e')?)/gc
					and pushtok($3?'object':'acc',"$1",qq{q<$2>})
		or /\G($comp)\s+law'/gc	and greater("$1")
		or /\G($comp)\s+puS/gc	and lesser("$1")
		or /\G$n_decl/gc	and decl(nostop $1)
		or /\G$sub_decl/gc	and sub_decl(nostop $1)
		or /\G$sing$v_usage/gc	and usage("$1")
		or /\G$sing$v_go/gc	and go("$1")
		or /\G$any$v_listop/gc	and listop("$1")
		or /\G$any$v_blockop/gc	and blockop("$1")
		or /\G$sing$v_match/gc	and match("$1")
		or /\G$any$v_change/gc	and change("$1")
		or /\G$sing$v_arg1/gc	and arg1("$1")
		or /\G$sing$v_arg1_da/gc	and arg1_da("$1")
		or /\G$plur$v_arg2/gc	and arg2("$1")
		# or /\G$plur$v_arg2_i/gc	and arg2_i("$1")
		or /\G$sing$v_arg2_da/gc	and arg2_da("$1")
		or /\G$sing$v_arg2_a/gc	and arg2_a("$1")
		or /\G$any$v_args/gc	and args("$1")
		or /\G$any$v_args_da/gc	and args_da("$1")
		or /\G$sing$v_unop/gc	and unop("$1")
		or /\G$sing$v_unop_dpre/gc
					and unop_dpre("$1")
		or /\G$sing$v_unop_dpost/gc
					and unop_dpost("$1")
		or /\G$plur$v_binop/gc	and binop("$1")
		or /\G$v_binop_np/gc	and binop("$1")
		or /\G$any$v_binop_d/gc	and binop_d("$1")
		or /\G$plur$v_ternop/gc	and ternop("$1")
		or /\G$control/gc	and control("$1")
		or /\G[yt]I([^\s!]+?)vetlh$EOW/gc
					and args_ur(nostop $1)
		or /\G[yt]I([^\s!]+)/gc	and args_u(nostop $1)
		or /\G[{]/gc		and startblock
		or /\G[}]/gc		and endblock
		or /\G[(]/gc		and startlist
		or /\G[)]($nsuff)/gc	and endlist("$1")
		or /\G((\S+?)$s_decl$EOW)/gc
					and pushtok('dat', "$1",
						    "$s_decl{$3} ".
						    ($sigil{substr$3,0,3}||'$').
						    nostop $2)
		or /\G((?:nuqDaq\s+)?(\S+?)laHwI'($nsuff)$EOW)/gc
					and pushtok($nsuff{$3}, "$1",
						    "\\&".nostop $2)
		or /\G(nuqDaq\s+(\S+?)($type)($nsuff)$EOW)/gc
					and pushtok($nsuff{$4}, "$1",
						    "\\".$sigil{$3}.nostop $2)
		or /\G((\S+?)($type)vetlh($nsuff)$EOW)/gc
					and pushtok($nsuff{$4}, "$1",
						    $sigil{$3}
						    . "{".nostop($2)."}")
		or /\G(nuqDaq\s+$noun_abl($nsuff)$EOW)/gc
					and pushtok($nsuff{$3},"$1",
						    "\\*$noun_abl{$2}")
		or /\G(nuqDaq\s+$noun_dat($nsuff)$EOW)/gc
					and pushtok($nsuff{$3},"$1",
						    "\\*$noun_dat{$2}")
		or /\G($noun_abl($nsuff)$EOW)/gc
					and pushtok($nsuff{$3},"$1",
						    $noun_abl{$2})
		or /\G($noun_dat($nsuff)$EOW)/gc
					and pushtok($nsuff{$3},"$1",
						    $noun_dat{$2})
		or /\G(nuqDaq\s+$noun_acc($nsuff)$EOW)/gc
					and pushtok($nsuff{$3},"$1",
						    "\\$noun_acc{$2}")
		or /\G($noun_acc($nsuff)$EOW)/gc
					and pushtok($nsuff{$3},"$1",
						    $noun_acc{$2})
		or /\G((\S+?)($type)($nsuff)$EOW)/gc
					and pushtok($nsuff{$4},"$1",
						    "$sigil{$3}". nostop $2) 
		or /\G(.+)\b/gc		and die "<<$1>>Daq ngoq SovlaHbe'"
							# Unrecognizable code
	}
	die "ngoq tlhol:\n\t" . join(" ", map $_->{raw}, @stack) . "\n "
		if @stack;				# unprocessed code
	$_ = $translation[0];
	print STDERR and exit if $TRANS;
}
qr/^\s*(Lingua(::|')tlhInganHol(::|')yIghun)?\s*(yI)?lo'Qo'\s*!\s*$/;

1;
__END__

=pod

=head1 NAME

Lingua::tlhInganHol::yIghun - "The Klingon Language: hey you, program in it!"


=head1 SYNOPSIS

	use Lingua::tlhInganHol::yIghun;
	
	<<'u' nuqneH!\n>> tIghItlh!
	 
	{
		wa' yIQong!
		Dotlh 'oH yIHoH yInob 
			qoj <mIw Sambe'> 'oH yIHegh jay'!
		<Qapla'!\n> yIghItlh!
	} jaghmey tIqel!


=head1 DESCRIPTION

The Lingua::tlhInganHol::yIghun module allows you to write Perl in 
the original Klingon.

=head2 Introduction

The Klingon language was first explained to Terrans in 1984 by Earth-born
linguist Dr Marc Okrand. Those who dare can learn more about it at the Klingon
Language Institute (www.kli.org).

The word order in Klingon sentences is I-O-V-S: indirect object, 
(direct) object, verb, subject. For example:

=over

B<luSpetna'vaD vay' vIghItlh jIH>

I<to-STDERR something write I>

=back

Naturally, commands given in the imperative form are far more common in
Klingon. In imperative statements, such as those used for programming
instructions, word order becomes I-O-V: indirect object, (direct)
object, (imperative) verb:

=over 

B<luSpetna'vaD vay' yIghItlh!>

I<to-STDERR something (I order you to) write!>

=back

Thus, for programming, Klingon is inherently a Reverse Polish notation.


=head2 Variables

Klingon uses inflection to denote number. So the command:

=over

B<luSpetna'vaD vay' yIghItlh!>

=back
           
is:

=over

I<to-STDERR something write!>

=back

whereas:

=over

I<to STDERR some B<things> write!>

=back

is:

=over

B<luSpetna'vaD vay'mey yIghItlh!>

=back


So in Klingon scalars and arrays can have the same root name 
(just as in regular Perl):

=over

B<vay'>    ---> C<$something>

B<vay'mey> ---> C<@something>

=back

The B<-mey> suffix only refers to things incapable of speech.
If the somethings had been articulate, the inflection would 
be:

=over

B<luSpetna'vaD vay'I<pu'> yIghItlh!>

=back

From a certain point-of-view, this parallels the difference between 
an array and a hash: arrays are subscripted mutely, with dumb integers;
whereas hashes are subscripted eloquently, with quoted strings.
Since hashes are thus in some sense "articulate", they are inflected
with the B<-pu'> suffix:

=over

B<vay'>    ---> C<$something>

B<vay'mey> ---> C<@something>

B<vay'pu'> ---> C<%something>

=back

=head2 Standard variables

Some variables have special names. Specifically:

B<'oH>		C<$_>		I<it>

B<biH>		C<@_>		I<them>

B<chevwI'>	C<$/>		I<that which separates>

B<natlhwI>	C<$|>		I<that which drains>


=head2 Subscripting arrays and hashes

Numerical subscripts are just ordinals. The command:

=over

C<kill $starships[5][3];>

=back

means:

=over

I<from starships, from the 5th of them, the 3rd of them, kill it!>

=back

which, in the Warrior's Tongue, is:

=over

B<'ejDo'meyvo' vagh DIchvo' wej Dich yIHoH!>

=back

The B<DIch> tag marks an ordinal number, whilst the ablative 
B<-vo'> suffix marks something being subscripted (i.e. something
that an element is taken from).

Note that the B<-mey> suffix on the original B<'ejDo'mey>
(C<@starships>) array didn't change. This implies that the literal
back-translation is:

=over

C<kill @starships[5][3];>

=back

Thus Klingon shows its superiority, in that it already honours the new
Perl 6 sigil conventions.

Hash indices have a different tag (B<Suq>). So:

=over

C<kill $enemies{"ancient"}{'human'};>

=back

which means:

=over

I<from enemies, from the "ancient" ones, the 'human' one, kill him!>

=back

is coded as:

=over

B<jaghpu'vo' E<lt>E<lt>ancientE<gt>E<gt> Suqvo' <humanE<gt> Suq yIHoH!>

=back

Once again the B<-pu'>"I'm-a-hash" suffix is retained when subscripting,
so the literal back-translation is the Perl6ish:

=over

C<kill %enemies{"ancient"}{'human'};>

=back

=head2 Element access through references

With references, the B<DIch> or B<Suq> tag still indicates what kind 
of thing is being subscripted. So there is no need for an explicit
dereferencer. So:

=over

B<jepaHDIlIwI'vo' E<lt>E<lt>stupidE<gt>E<gt> Suqvo' wa' DIch yIHoH!>

=back

can be translated:

=over

C<kill $jeopardyPoster{"stupid"}[1];     # Perl 6 syntax>

=back

but also means:

=over

C<kill $jeopardyPoster-E<gt>{"stupid"}[1];   # Perl 5 syntax>

=back


=head2 Distinguishing lvalues

All the variables shown above were written in the (uninflected)
accusative case. This is because they were used as direct objects 
(i.e. as data).

When variables are assigned to, they become indirect objects of 
the assignment (I<give the weapon B<to me>>). This means
that targets of assignment (or any other form of modification)
must be specified in the dative case, using the B<-vaD> suffix:

=over

B<'ejDo'meyvaD wa' 'uy' chen tInob!>

C<@starships = (1..1000000);>

=back

=over

B<jaghpu'vaD (E<lt>E<lt>QIpE<gt>E<gt> wa' E<lt>E<lt>jIvE<gt>E<gt> cha') tInob!>

C<%enemies = (stupidity=E<gt>1, ignorance=E<gt>2);>

=back

=over

B<jepaHDIlIwI'vo' wa' Dichvo' E<lt>E<lt>stupidE<gt>E<gt> SuqvaD ghur!>

C<++$jeopardyPoster-E<gt>[1]{"stupid"};>

=back


=head2 Variable declarations

Variable declarations also use suffixes for lexicals:

=over

B<scalarwIj!>	--->	my $scalar;

B<arraymeywIj!>	--->	my @array;

B<hashpu'wI'!>	--->	my %hash;

=back

for package variables:

=over

B<scalarmaj!>	--->	our $scalar;

B<arraymeymaj!>	--->	our @array;

B<hashpu'ma'!>	--->	our %hash;

=back

and for temporaries:

=over

B<scalarvam!>	--->	local $scalar;

B<arraymeyvam!>	--->	local @array;

B<hashpu'vam!>	--->	local %hash;

=back

=head2 Operators and other punctuation

In general, programming Perl in the original Klingon
requires far less punctuation than in the Terran corruption.

The only punctuation components of the language are:

=over 

=item B<E<lt>> and B<E<gt>>

These are B<pach poS> (I<left claw>) and B<pach niH>
(I<right claw>). They delimit an uninterpolated
character string. For example:

=over 

B<E<lt>petaQE<gt> yiHegh!>	--->	C<die 'scum';>

=back

=item B<E<lt>E<lt>> and B<E<gt>E<gt>>

These are B<pachmey poS> (I<left claws>) and B<pachmey niH>
(I<right claws>). They delimit an interpolated
character string. For example:

=over 

B<E<lt>E<lt>petaQ\nE<gt>E<gt> yiHegh!>	--->	C<die "scum\n";>

=back

=item B<(> and B<)>

These are B<'etlh HivtaH> and B<'etlh HubtaH>
(I<attaching sword> and I<defending sword>). They are used
as grouping expressions. For example:

=over

B<xvaD wa' (cha maH yIfunc) yIlogh yInob!>	--->	C<$x = 1*func(2,10)>

=back

For standard operators and functions with fixed parameter lists, this kind
of grouping is not needed due to the RPN ordering of Klingon:

=over

B<xvaD wa' cha maH yIchel yIlogh yInob!>        --->    C<$x = 1*(2+10)>

=back

=item B<{> and B<}>

These are B<betleH HivtaH> and B<betleH HubtaH>
(I<attacking batleth> and I<defending batleth>). 
They are used to group complete statements. For example:

=over

B<x joq { 'oH yIghItlh! 'oHvaD yIghur! } yIvang!>   --->	S<$x && do{ print $_; $_++ }>

=back

=item B<#>

This is the B<tajmey gho> (I<circle of daggers>), which is used to
indicate the beginning of a comment (which then runs to the end of the
line). Its use is widely reviled as a sign of weakness.

=back

=head2 Operators

The Klingon binding of Perl does not use sniveling Terran symbols
for important operations. It uses proper words. For example:

        =                 yInob                 "give!"
        +                 tIchel                "add!"
        -                 tIchelHa'             "un-add!"
        ++...             yIghur                "increase!"
        ...++             yIghurQav             "increase afterwards!"
        ..                tIchen                "form up!"
        eq                rap'a'                "the same?!"
        ==                mI'rap'a'             "the same number?!"

For a complete list, see L<Appendix 2|"Appendix 2: Terran-thlIngan dictionary">

Note that they all appear at the end of their argument lists:

	Qapla' vum toDuj yIchel buDghach yichelHa' yInob!
	       |_| |___| |____| 
               |______________| |______| |_______| 
	|____| |_________________________________| |____|


Most of the above examples begin with B<yI-> or B<tI->.
These prefixes indicate an imperative verb referring to one or
many objects (respectively). 

Hence, assignment is B<yInob> (I<give B<it> to...>), whilst
addition is B<tIchel> (I<add B<them>>).

Of course, in the heat of coding there is often not time for these
syntactic niceties, so Lingua::tlhIngan::yIghun allows you do just
drop them (i.e. use "clipped Klingon") if you wish.


=head2 Numeric literals

Klingon uses a decimal numbering system. The
digits are: 

=over

0       B<pagh>

1       B<wa'>

2       B<cha'>

3       B<wej>

4       B<loS>

5       B<vagh>

6       B<jav>

7       B<Soch>

8       B<chorgh>

9       B<Hut> 

=back

Powers of 10 are: 

=over

10      B<maH>

100     B<vatlh>

1000    B<SaD> or B<SanID>

10000   B<netlh>

100000  B<bIp>

1000000 B<'uy'>

=back

Numbers are formed by concatenating the appropriate digit and power
of ten in a descending sequence. For example:

=over

B<yearvaD wa'SaD Hutvatlh chorghmaH loS yInob!> --->    C<$year = 1984;>

=back

Decimals are created by specifying the decimal mark (B<DoD>) then
enumerating post-decimal digits individually.
For example:

=over

B<pivaD wej DoD wa' loS wa' vagh yInob!>        --->    C<$pi = 3.1415;>

=back

=head2 References

References are created by prepending the query B<nuqDaq> (I<where is...>)
to a referent. For example:

=over

B<refvaD nuqDaq var yInob!>     --->    C<$ref = \$var;>

=back

To dereference, the appropriate
B<-vetlh>, B<-meyvetlh>, or B<-pu'vetlh> suffix
(I<that...>, I<those...>, I<those ...>) is used, depending on the
type of the referent. For example:

=over

B<refvetlh yIghItlh!>           --->    C<print ${$ref};>

B<refmeyvetlh tIghItlh!>        --->    C<print @{$ref};>

B<refpu'vetlh tIghItlh!>        --->    C<print %{$ref};>

=back

=head2 Conjunctives and disjunctives

Just as Terran Perl's conjunctive and disjunctive operators come
in two precedences, so too do those of The Warrior's Perl.

When joining expressions, the high precedence operators (B<joq> and B<je>)
are used:

=over

B<x yImI'Suq joq yIghItlh!>     --->    C<print($x || get_num();)>

B<zvaD x yIy je yInob!>         --->    C<$z = ($x && y());>

=back

Unlike all other operators in Klingon, low-precedence
conjunctives and disjunctives (i.e. those between complete commands) are infix,
not postfix. The low precedence operators are B<qoj> and B<'ej>:

=over

B<x yIghItlh qoj yImI'Suq!>     --->    C<print($x) or get_num();>

B<zvaD x yInob 'ej yIy!>        --->    C<($z = $x) or y();>

=back

Note that (as the above exampe illustrate) changing precedence often
necessitates a radical change in word order.
                

=head2 Object-oriented features

Klingon Perl does not pander to feeble Terran object-oriented sensibilities 
by treating objects and methods specially.

A method is a subroutine, so in Klingon Perl
it is called exactly like a subroutine.

The first argument of a method is special, so 
in Klingon Perl it is explicitly marked it as being special.

For example, the procedural command:

=over

B<Hich DoSmey yIbaH!>

=back

translates as:

=over 

C<fire($weapon,@targets);>

=back

To call the same subroutine as a method, with C<$weapons> as its
invocant object, it is necessary to mark the referent using the 
topicalizer B<'e'>: 

=over

B<Hich'e' DoSmey yIbaH!>

=back

This then translates as:

=over

C<$weapon-E<gt>fire(@targets);>

=back

Likewise class methods are invoked by topicalizing the class name:

=over

B<E<lt>E<lt>JaghE<gt>E<gt>>'e' yItogh yIghItlh!>

=back

which is:

=over

C<print "Enemy"-E<gt>count();>

=back

To create an object, the B<DoQ> (I<claim ownership of>) command is used:

        {
            buvwIj bIH yInIH!              # my $class = shift @_;
            De'pu'wI' bIH yInob!           # %data = @_;
            nuqDaq De' buv yIDoQ yItatlh!  # return bless \%data, $class;
        } chu' nab!			   # sub new


=head2 Comparisons

The equality comparison operators (C<==>, C<!=>, C<eq>, C<ne>) are implemented
as questions in Klingon:

=over

B<x y rap'a'>           ---> C<$x eq $y>     (I<"x y are they the same?">)

B<x y mI'rap'a'>        ---> C<$x == $y>     (I<"x y are they the same number?">)

B<x y pIm'a'>           ---> C<$x ne $y>     (I<"x y are they different?">)

B<x y mI'pIm'a'>        ---> C<$x != $y>     (I<"x y are they different numbers?">)

=back

Inequalities are expressed with a different grammatical structure in Klingon.
There is only one inequality operator, whose syntax is:

=over

B<I<expr1> I<comparator> law' I<expr2> I<comparator> puS>

=back

Literally this means:

=over

I<comparator(expr1) is many; comparator(expr2) is few>

=back

or, in other words:

=over

I<comparator(expr1) E<gt> comparator(expr2)>

=back

The comparators tlhInganHol::yIghun supports are:

=over

=item C<E<gt>> : B<tIn>

=item C<E<lt>> : B<mach>

=item C<E<gt>=> : B<machbe'>

=item C<E<lt>> : B<tInbe'>

=item C<gt> : B<tlha'>

=item C<lt> : B<nung>

=item C<ge> : B<nungbe'>

=item C<le> : B<tlha'be'>

=back

For example:

=over

B<{ E<lt>E<lt>qaplaE<gt>E<gt> yIghItlh } mebmey mach law' maH mach puS je Soj nungbe' law' E<lt>qaghE<gt> nungbe' puS teHchugh!>

C<print "qapla!" if @guests < 10 && $food ge 'qagh';>

=back

=head2 Flow control

The flow control directives are:

=over

B<teHchugh>     C<if>           I<if is true>

B<teHchughbe'>  C<unless>       I<if is not true>

B<teHtaHvIS>    C<while>        I<while being true>

B<teHtaHvISbe'> C<until>        I<while not being true>

B<tIqel>        C<for(each)>    I<consider them>

B<yIjaH>	C<goto>		I<go!>

B<yInargh>	C<last>		I<escape!>

B<yItaH>	C<next>		I<go on>

B<yInIDqa'>	C<redo>		I<try again>

=back

=head2 Builtin functions

Perl builtins are represented as imperative verbs in tlhInganHol::yIghun.
L<Appendix 1|"Appendix 1: thlIngan-Terran dictionary">
has the complete list.

As with operators, they may take B<yI-> or B<tI-> prefixes and are themselves
postfix (the verb after it's arguments).

Note that there are a suitably large number of variations on the C<kill>
command.


=head2 User-defined subroutines

A user-defined subroutine is specified in a B<betleH> delimited block,
and given a name using the B<nab> (I<procedure>) specifier. For example:

	{
		<<Qapla'!\n>> ghItlh!
	} doit nab!

means:

	sub doit {
		print "Qapla'!\n";
	}

Such subroutines are then called using the (non-optional) B<yI->
or B<tI-> prefix:

	yIdoit!

Anonymous subroutines are created by omitting the name:

	refwIj {
		<<Qapla'!\n>> ghItlh!
	} nab nob!

which is:

	my $ref = sub {
                print "Qapla'!\n";
        }

Subroutine references can also be created by suffixing a subroutine name
with B<-laHwI'> (I<one who can...>):

	refwIj doitlaHwI' nob!

Either way, the subroutine is called through a reference by appending the
B<-vetlh> suffix (I<that...">) and prepending the imperative B<yI-> or B<tI->:

	yIrefvetlh!


=head2 Pattern matching

Patterns (or B<nejwI'>) are specified using the same line-noise syntax as in
Terran Perl.

To match against a pattern, the B<ghov> verb (I<recognize>) is used:

	'oH <\d+> yIghov 'ej <<vItu'>> yIghItlh!

which means:

	$_ =~ m/\d+/ and print "found it";

Note that the value being matched against must be explicitly specified,
even if it is B<'oH>.

To substitute against a pattern, use B<tam> (I<substitute>):

	De'vaD <\d+> <\n> yItam!

which means:

	$data =~ s/\d+/\n/;

The container whose value is being substituted must be explicitly
specified (again, even if it is B<'oH>). It is also the target of the
action and thus takes the B<-vaD> suffix.


=head2 Invective operator

Klingon is a language of great emotional depth.
By comparison, programming in Terran languages is an insipid, bloodless
experience.

Of particular note is the special programming construct: B<jay'>.
In Klingon it may be appended to a sentence to enhance it's emotional
intensity. Thus:

=over

B<qaSpu' nuq 'e' yIja'!>

I<Tell me what happened!>

=back

becomes:

=over

B<qaSpu' nuq 'e' yIja' jay'!>

I<Tell me what the *#@& happened!>

=back

This useful and satisfying internal documentation technique can be
used anywhere in a tlhInganHol::yIghun program. For example:

=over

B<{ E<lt>E<lt>De' sambe'E<gt>E<gt> yIghItlh jay'! } tu' yItlhoch teHchugh!>

C<if (!$found) { *#@&-ing print "Missing data!" }>

=back


=head2 Module control options

If the module is imported with the argument B<yIQij>:

        use Lingua::tlhInganHol::yIghun "yIQij";

it runs in debugging mode.

If the module is imported with the argument B<yImugh>:

        use Lingua::tlhInganHol::yIghun "yImugh";

it demeans itself to merely translating your glorious Klingon Perl code
into a pale Terran Perl imitation.

If the module is imported with the argument B<tera'nganHol> (or
B<tera::nganHol>:

        use Lingua::tlhInganHol::yIghun "tera'nganHol";

it debases itself to output numeric values in Terran, rather than in
the original Klingon.


=head1 DIAGNOSTICS

=over 4

=item C<<< <<Suq>> yIlo'Qo' <<DIch>> yIlo' jay' >>>

Array indices take the I<ordinal> suffix B<DIch>! You fool!

=item C<<< <<DIch>> yIlo'Qo' <<Suq>> yIlo' jay' >>>

Hash keys are indicated by B<Suq>, not an ordinal! You
imbecile!

=item C<<< %s: pong Sambe'! >>>

You forgot the name of a subroutine, package, or module! You cretin!

=item C<<< %s: pong ngoqghom joq Sambe'! >>>

You forgot to specify the name of a subroutine or a raw block! You moron!

=item C<<< %s: ngoqghom Sambe'! >>>

You forgot to specify a raw block! You idiot!

=item C<<< %s: nejwI' Sambe'! >>>

You forgot to specify a pattern! You dolt!

=item C<<< %s: tamwI' Sambe'! >>>

You forgot to specify a value to be substituted! You simpleton!

=item C<<< %s: De' Sambe'! >>>

You forgot to specify an argument! You half-wit!

=item C<<< %s: De' wa'DIch Sambe'! >>>

You forgot to specify the first argument! You clod!

=item C<<< %s: De' cha'DIch Sambe'! >>>

You forgot to specify the second argument! You knucklehead!

=item C<<< %s: DoS ghap Hal Sambe'! >>>

You forgot to specify a filehandle! You oaf!

=item C<<< %s: Hal Sambe'! >>>

You forgot to specify an input filehandle! You jerk!

=item C<<< %s: wuqwI' Sambe'! >>>

You forgot to specify a boolean expression for a ternary operator! You dumbbell!

=item C<<< %s: vItvaD Sambe'! >>>

You forgot to specify an "if true" value for a ternary operator! You buffoon!

=item C<<< %s: nepvaD Sambe'! >>>

You forgot to specify an "if false" value for a ternary operator! You dope!

=item C<<< %s: tob Sambe'! >>>

You forgot to specify a test for a control statement! You dummy!

=item C<<< %s: Doch Sambe'! >>>

You forgot to specify an object! You dunce!

=item C<<< %s %sDaq: ra' PoS pIHbe! >>>

What is that command doing on the left of that conjunction?! You dimwit!

=item C<<< %s %sDaq: 'rIn pIHbe! >>>

Where is the rest of the command?! You nincompoop!

=item C<<< betleH HivtaH Sampa' veQ: %s >>>

What is that garbage before the opening brace?! You dunderhead!

=item C<<< 'etlh HivtaH Sambe' >>>

Where is the opening parenthesis? You numbskull!

=item C<<< %s puS: DIp %sbe' Sambe' >>>

Where is the variable you're comparing?! You goose!

=item C<<< %s puS: <<%s law>> nung Sambe' >>>

Where is the B<I<comparator> law'> for this comparison? You blockhead!

=item C<<< %s: DIp poS Sambe' >>>

Where is the left operand?! You chump!

=item C<<< %sDaq ngoq Sovlahbe' >>>

This code is meaningless! You nimrod!

=item C<<< ngoq tlhol: %s >>>

What is this extra code doing here?! You I<human>!

=back


=head1 AUTHOR

Damian Conway <damian@conway.org> is the original author.

Michael G Schwern <schwern@pobox.com> assisted in its escape.


=head1 REPOSITORY

The source code of this module can be taken from
L<http://github.com/schwern/lingua-tlhinganhol-yighun/tree/master>


=head1 BUGS

In this module??? I should kill you where you stand!  You speak the
lies of a tah-keck!  If a p'tahk such as you dares insult our honor
with your bug report, you will send it to
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Lingua-tlhInganHol-yIghun>!


=head1 SEE ALSO

The Klingon Language Institute <http://www.kli.org/>

The Varaq programming language <http://www.geocities.com/connorbd/varaq/>


=head1 COPYRIGHT

       Copyright (c) 2001-2009, Damian Conway. All Rights Reserved.
       This module is free software. It may be used, redistributed
           and/or modified under the same Terms as Perl itself.


=head1 Appendix 1: thlIngan-Terran dictionary

        thlIngan        Terran          
        ========        ======
        'ar             abs
        'ej             and
        'ov             cmp
        'uy'            -000000
        -DoS            <suffix indicates use as an output handle>
        -Hal            <suffix indicates use as an input handle>
        -laHwI'         \& (subroutine reference)
        -vo'            suffix indicating something indexed
        bach            kill
        bagh            tie
        bagh'a'         tied
        baghHa'         untie
        bIp             -00000
        bogh            fork
        boS             pack
        boSHa'          unpack
        bot             flock
        buv             ref
        cha'            2
        chaqpoDmoH      chomp
        chel            + (addition)
        chelHa'         - (subtraction)
        chen            ..
        chen            ..
        chevwI'         $/
        chImmoH         undef
        choH            map
        chorgh          8
        chot            kill
        chov            eval
        chuv            %
        De'Daqvo'       DATA
        Del             stat
        DIch            ...[...]
        DIchvaD         ...[...] (when it's an lvalue)
        DIchvo'         ...[...] (when it's to be further indexed)
        DIS             kill
        Dochmeyvam      @_
        Dochvam         $_
        DoQ             bless
        DuQ             splice
        ghItlh          print
        ghochna'	STDOUT (used as name -- i.e. in an open)
        ghochna'DoS     STDOUT (used as handle -- i.e. in a print)
        ghomchoH        chdir
        ghomneH         wantarray
        ghomtagh        mkdir
        ghomteq         rmdir
        ghov            m
        ghuHmoH         warn
        ghum            alarm
        HaD             study
        Hegh            die
        Hiv             kill
        HoH             kill
        Hut             9
        ja'             tell
        jaH             goto
        jav             6
        jegh            unshift
        jey             kill
        joqtaH          sin
        joqtaHHa'       cos
        juH             main
        juv             length
        laD             readline
        mungna'vo'      STDIN (used as name -- i.e. in an open)
        mungna'vo'Hal   STDIN (used as handle -- i.e. in a readline)
        lagh            substr
        lI'a'           exists
        lo'             use
        lo'laH          values
        lo'Qo'          no
        lo'Sar          sqrt
        logh            x
        loS             4
        loS             wait
        ma'             our
        mach            lc
        mach law'       lt
        machbe' law'    ge
        maH             -0
        maHghurtaH      log
        maj             our
        mej             exit
        mI'pIm'a'       !=
        mI'rap'a'       ==
        mIS             rand
        mIScher         srand
        mISHa'          sort
        mob             scalar
        mol             dump
        mugh            tr
        muH             kill
        muv             join
        nab             sub
        nargh           quotemeta
        natlhwI'        $|
        naw'choH        chmod
        nej             seek
        neq             rename
        netlh           -0000
        nIH             shift
        nob             =
        noD             reverse
        nup             truncate
        pa'ghuHmoH      carp
        pa'Hegh         croak
        pagh            0
        pIm'a'          ne
        pIn'a'choH      chown
        poD             int
        poDmoH          chop
        pong            keys
        pongwI'         caller
        poQ             require
        poS             open
        luSpetna'	STDERR (used as name -- i.e. in an open)
        luSpetna'DoS    STDERR (used as handle -- i.e. in a print)
        Qaw'            delete
        qoj             or
        qojHa'          atan2
        Qong            sleep
        ra'             system
        rap'a'          eq
        rar             link
        rIn             continue
        rIn             continue
        rIn'a'          eof
        Sach            glob
        SaD             -000
        Sam             index
        SanID           -000
        Say'moH         reset
        sIj             split
        So'             crypt
        Soch            7
        SoQmoH          close
        Such            each
        Suq             ...{...}
        SuqvaD          ...{...} (when it's an lvalue)
        Suqvo'          ...{...} (when it's to be further indexed)
        tagh            exec
        tam             s
        tatlh           return
        teHchugh        if
        teHchughbe'     unless
        teHtaHvIS       while
        teHtaHvISbe'    until
        teq             unlink
        tI-             imperative prefix (2 or more arguments)
        tIn             uc
        tIn law'        gt
        tInbe' law'     le
        tIqel           for
        tlhoch          not
        toq'a'          defined
        vagh            5
        vam             local
        vang            do
        vatlh           -00
        wa'             1
        wa'Dichmach     lcfirst
        wa'DichtIn      ucfirst
        wej             3
        wI'             my
        wIj             my
        wIv             grep
        woD             pop
        wuq             ...?...:...
        yI-             imperative prefix (0 or 1 argument)
        yInargh         last
        yInHa'          kill
        yInIDqa'        redo
        yItaH           next 
        yoS             package
        yuv             push




=head1 Appendix 2: Terran-thlIngan dictionary

        
        Terran          thlIngan        Literal translation
        ======          ========        ===================
        =               nob             "give"
        ..              chen            "build up"
        {...}           {...}           "attacking batleth...defending batleth"
                                        (betleH HivtaH...betleH HubtaH")
        (...)           (...)           "attacking sword...defending sword"
                                        ('etlh HivtaH...'etlh HubtaH")
        ...[...]        DIch            ordinal suffix
        ...{...}        Suq             "get"
        ...?...:...     wuq             "decide"
        x               logh            "repeated"
        %               chuv            "be left over"
        +               chel            "add"
        -               chelHa'         "un-add"
        /               wav             "divide"
        ==              mI'rap'a'       "number same?"
        !=              mI'pIm'a'       "number different?"
        \& <sub ref>    -laHwI'         "one who is able to do..."
        abs             'ar             "how much"
        alarm           ghum            "alarm"
        and             'ej             "and"
        atan2           qojHa'          "anti cliff"
        bless           DoQ             "claim ownership of"
        caller          pongwI'         "one who calls"
        carp            pa'ghuHmoH      "warn over there"
        chdir           ghomchoH        "change grouping"
        chmod           naw'choH        "change access"
        chomp           chaqpoDmoH      "maybe clip"
        chop            poDmoH          "clip"
        chown           pIn'a'choH      "change master"
        close           SoQmoH          "close"
        cmp             'ov             "compete"
        continue        rIn             "be complete"
        cos             joqtaHHa'       "counter waving"
        croak           pa'Hegh         "die over there"
        crypt           So'             "hide"
        DATA            De'Daqvo'       "place from which data comes"
        defined         toq'a'          "is inhabited"
        delete          Qaw'            "destroy"
        die             Hegh            "die"
        do              vang            "take action"
        dump            mol             "bury"
        each            Such            "visit"
        eof             rIn'a'          "is finished"
        eq              rap'a'          "same?"
        eval            chov            "evaluate"
        exec            tagh            "begin a process"
        exists          lI'a'           "is useful"
        exit            mej             "depart"
        flock           bot             "prohibit"
        for             tIqel           "consider them"
        fork            bogh            "be born"
        ge              machbe' law'    "be not smaller"
        glob            Sach            "expand"
        goto            jaH             "go"
        grep            wIv             "choose"
        gt              tIn law'        "be larger"
        if              teHchugh        "if true"
        index           Sam             "locate"
        int             poD             "clip"
        join            muv             "join"
        keys            pong            "name"
        kill            HoH             "kill"
        kill            muH             "execute"
        kill            chot            "murder"
        kill            bach            "shoot"
        kill            Hiv             "attack"
        kill            DIS             "stop"
        kill            jey             "defeat"
        last            yInargh         "escape"
        lc              mach            "be small"
        lcfirst         wa'Dichmach     "the first be small"
        le              tInbe' law'     "be not larger"
        length          juv             "measure"
        link            rar             "connect"
        local           vam             "this"
        log             maHghurtaH      "ten log"
        lt              mach law'       "be smaller"
        m               ghov            "recognize"
        main            juH             "home"
        map             choH            "alter"
        mkdir           ghomtagh        "initiate grouping"
        my              wI'             "my sapient"
        my              wIj             "my"
        ne              pIm'a'          "different?"
        next            yItaH           "go on"
        no              lo'Qo'          "don't use"
        not             tlhoch          "contradict"
        open            poS             "open"
        or              qoj             "inclusive or"
        our             ma'             "our sapient"
        our             maj             "our"
        pack            boS             "collect"
        package         yoS             "district"
        pop             woD             "throw away"
        print           ghItlh          "write"
        push            yuv             "push"
        quotemeta       nargh           "escape"
        rand            mIS             "confuse"
        readline        laD             "read"
        redo            yInIDqa'        "try again"
        ref             buv             "classify"
        rename          neq             "move"
        require         poQ             "demand"
        reset           Say'moH         "cause to be clean"
        return          tatlh           "return something"
        reverse         noD             "retaliate"
        rmdir           ghomteq         "remove grouping"
        s               tam             "substitute"
        scalar          mob             "be alone"
        seek            nej             "seek"
        shift           nIH             "steal"
        sin             joqtaH          "waving"
        sleep           Qong            "sleep"
        sort            mISHa'          "be not mixed up"
        splice          DuQ             "stab"
        split           sIj             "slit"
        sqrt            lo'Sar          "fourth how much"
        srand           mIScher         "establish confusion"
        stat            Del             "describe"
        STDIN  <name>   mungna'vo'      "from the origin"
        STDIN  <handle> mungna'vo'Hal   "from the origin (source)"
        STDOUT <name>   ghochna'        "the destination"
        STDOUT <handle> ghochna'DoS     "the destination (target)"
        STDERR <name>   luSpetna'       "the black hole"
        STDERR <handle> luSpetna'DoS    "the black hole (target)"
        study           HaD             "study"
        sub             nab             "procedure"
        substr          lagh            "take apart"
        system          ra'             "command"
        tell            ja'             "report"
        tie             bagh            "tie"
        tied            bagh'a'         "is tied"
        tr              mugh            "translate"
        truncate        nup             "decrease"
        uc              tIn             "be big"
        ucfirst         wa'DichtIn      "the first be big"
        undef           chImmoH         "cause to be uninhabited"
        unless          teHchughbe'     "if not true"
        unlink          teq             "remove"
        unpack          boSHa'          "un collect"
        unshift         jegh            "surrender"
        untie           baghHa'         "untie"
        until           teHtaHvISbe'    "while not true"
        use             lo'             "use"
        values          lo'laH          "be valuable"
        wait            loS             "wait for"
        wantarray       ghomneH         "want group"
        warn            ghuHmoH         "warn"
        while           teHtaHvIS       "while true"
        pIm'a'          ne              "are they different?"
        rap'a'          eq              "are they the same?"
        0               pagh            0
        1               wa'             1
        2               cha'            2
        3               wej             3
        4               loS             4
        5               vagh            5
        6               jav             6
        7               Soch            7
        8               chorgh          8
        9               Hut             9
        -0              maH             -0
        -00             vatlh           -00
        -000            SaD             -000
        -000            SanID           -000
        -0000           netlh           -0000
        -00000          bIp             -00000
        -000000         'uy'            -000000
        $_              'oH             "it"
        @_              bIH             "them"
        $/              chevwI'         "that which separates"
        $|              natlhwI'        "drain?"