natopat

#!/usr/bin/env perl
use strict;
use warnings;

use Getopt::Std;

our $opt_r = 0;
getopts('r');

my %chars = (
	'a' => 'alpha',
	'b' => 'bravo',
	'c' => 'charlie',
	'd' => 'delta',
	'e' => 'echo',
	'f' => 'foxtrot',
	'g' => 'golf',
	'h' => 'hotel',
	'i' => 'india',
	'j' => 'juliet',
	'k' => 'kilo',
	'l' => 'lima',
	'm' => 'mike',
	'n' => 'november',
	'o' => 'oscar',
	'p' => 'papa',
	'q' => 'quebec',
	'r' => 'romeo',
	's' => 'sierra',
	't' => 'tango',
	'u' => 'uniform',
	'v' => 'victor',
	'w' => 'whiskey',
	'x' => 'x-ray',
	'y' => 'yankee',
	'z' => 'zulu',
);

for (keys %chars)
{
	$chars{uc($_)} = ucfirst($chars{$_});
}

%chars = (
	%chars,
	'0' => 'nadazero',
	'1' => 'unaone',
	'2' => 'bissotwo',
	'3' => 'terrathree',
	'4' => 'kartefour',
	'5' => 'pantafive',
	'6' => 'soxisix',
	'7' => 'setteseven',
	'8' => 'oktoeight',
	'9' => 'novenine',
);

my $allwords = '(' . join ('|', values %chars) . ')';

while (<>)
{
	chomp;
	unless ($opt_r)
	{
		s/([a-zA-Z0-9])/$chars{$1} /g;
		s/(?<=[a-zA-Z])\s(?![a-zA-Z\s])//g;
		s/\s+$//;
	} else {
		s/$allwords\ ?/(grep{$chars{$_} eq $1} keys %chars)[0]/ego;
	}
	print $_, "\n"
}

__END__

=head1 NAME

natopat - NATO phonetic alphabet translator

=head1 SYNOPSIS

B<natopat> [I<-r>]

=head1 DESCRIPTION

B<natopat> reads strings from STDIN and translates letters and digits to NATO
phonetic alphabet.

=head1 OPTIONS

=item I<-r>

Translate from phonetic alphabet to normal letters and digits.  The default is
to do the opposite.

=head1 AUTHOR

Copyright (c) 2008 Vsevolod Kozlov <zaba@thorium.homeunix.org>

=head1 LICENSE

Do anything with it.