File Coverage

blib/lib/Lingua/Alphabet/Phonetic.pm
Criterion Covered Total %
statement 24 24 100.0
branch 1 2 50.0
condition 3 4 75.0
subroutine 6 6 100.0
pod 2 2 100.0
total 36 38 94.7


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Lingua::Alphabet::Phonetic - map ABC's to phonetic alphabets
5              
6             =head1 SYNOPSIS
7              
8             use Lingua::Alphabet::Phonetic;
9             my $oMilSpeaker = new Lingua::Alphabet::Phonetic('NATO');
10             my @asMilSpeak = $oMilSpeaker->enunciate('ABC');
11              
12             =head1 DESCRIPTION
13              
14             At present, the only alphabet available for conversion is the
15             U.S. Military / NATO standard where "ABC...YZ" is pronounced "Alpha
16             Bravo Charlie ... Yankee Zulu". It is called 'NATO' and it is
17             included with this distribution.
18              
19             =head1 METHODS
20              
21             =over
22              
23             =cut
24              
25             #####################################################################
26              
27             package Lingua::Alphabet::Phonetic;
28              
29 2     2   25123 use strict;
  2         3  
  2         51  
30 2     2   6 use warnings;
  2         2  
  2         364  
31              
32             our
33             $VERSION = 1.12;
34              
35             =item new
36              
37             Create an object of this class. See SYNOPSIS above.
38              
39             =cut
40              
41             sub new
42             {
43 1     1 1 13 my $class = shift;
44 1   50     5 my $sAlphabet = shift || '';
45 1         4 my $sSubclass = "${class}::$sAlphabet";
46 1     1   9 eval "use $sSubclass";
  1         1  
  1         19  
  1         86  
47 1 50       6 Carp::croak("Unknown phonetic alphabet $sAlphabet: $@") if ($@);
48 1         4 my $self = bless {
49             }, $sSubclass;
50 1         4 return $self;
51             } # new
52              
53              
54             =item enunciate
55              
56             Given a string, returns a list of phonetic alphabet "words", one word
57             per character of the original string. If there is no "word" in the
58             alphabet for a character, that character is returned in the list
59             position.
60              
61             =cut
62              
63             sub enunciate
64             {
65 4     4 1 2121 my $self = shift;
66 4   100     18 my $s = shift || '';
67 4         15 my @ac = split('', $s);
68 4         13 return map { $self->_name_of_letter($_) } @ac;
  6         17  
69             } # enunciate
70              
71              
72             sub _name_of_letter
73             {
74             # This is the default fallback character --> word mapping.
75 2     2   3 my $self = shift;
76 2         4 my $s = shift;
77             # Just return our argument unchanged:
78 2         9 return $s;
79             } # _name_of_letter
80              
81             =back
82              
83             =head1 OTHER ALPHABETS
84              
85             To create a conversion scheme for another alphabet, simply subclass
86             this module and provide a method _name_of_letter() which takes a
87             character and returns its phonetic name. See NATO.pm as an example.
88              
89             =head1 SEE ALSO
90              
91             http://en.wikipedia.org/wiki/Spelling_alphabet is a brief overview
92              
93             http://www.bckelk.uklinux.net/phon.full.html contains a list of
94             phonetic alphabets from all over the world!
95              
96             =head1 TO-DO
97              
98             =over
99              
100             =item Implement more alphabets.
101              
102             =item Investigate how we might handle non-ASCII alphabets. Unicode?
103              
104             =back
105              
106             =head1 BUGS
107              
108             Please tell the author if you find any!
109              
110             =head1 LICENSE
111              
112             This software is released under the same license as Perl itself.
113              
114             =head1 AUTHOR
115              
116             Martin 'Kingpin' Thurn, C, L.
117              
118             =cut
119              
120             1;
121              
122             __END__