3 # (c) Copyright 1998-2007 by Mark Mielke
5 # Freedom to use these sources for whatever you want, as long as credit
6 # is given where credit is due, is hereby granted. You may make modifications
7 # where you see fit but leave this copyright somewhere visible. As well, try
8 # to initial any changes you make so that if I like the changes I can
9 # incorporate them into later versions.
11 # - Mark Mielke <mark@mielke.cc>
14 package Text::Soundex;
22 our $VERSION = '3.03';
23 our @EXPORT_OK = qw(soundex soundex_unicode soundex_nara soundex_nara_unicode
25 our @EXPORT = qw(soundex soundex_nara $soundex_nocode);
26 our @ISA = qw(Exporter);
30 # Previous releases of Text::Soundex made $nocode available as $soundex_nocode.
31 # For now, this part of the interface is exported and maintained.
32 # In the feature, $soundex_nocode will be deprecated.
33 *Text::Soundex::soundex_nocode = \$nocode;
37 # Original Soundex algorithm
41 $code =~ tr/AaEeHhIiOoUuWwYyBbFfPpVvCcGgJjKkQqSsXxZzDdTtLlMmNnRr//cd;
44 my $firstchar = substr($code, 0, 1);
45 $code =~ tr[AaEeHhIiOoUuWwYyBbFfPpVvCcGgJjKkQqSsXxZzDdTtLlMmNnRr]
46 [0000000000000000111111112222222222222222333344555566]s;
47 ($code = substr($code, 1)) =~ tr/0//d;
48 substr($firstchar . $code . '000', 0, 4);
54 wantarray ? @results : $results[0];
59 # US census (NARA) algorithm.
63 $code =~ tr/AaEeHhIiOoUuWwYyBbFfPpVvCcGgJjKkQqSsXxZzDdTtLlMmNnRr//cd;
66 my $firstchar = substr($code, 0, 1);
67 $code =~ tr[AaEeHhIiOoUuWwYyBbFfPpVvCcGgJjKkQqSsXxZzDdTtLlMmNnRr]
68 [0000990000009900111111112222222222222222333344555566]s;
69 $code =~ s/(.)9\1/$1/gs;
70 ($code = substr($code, 1)) =~ tr/09//d;
71 substr($firstchar . $code . '000', 0, 4);
77 wantarray ? @results : $results[0];
82 require Text::Unidecode unless defined &Text::Unidecode::unidecode;
83 soundex(Text::Unidecode::unidecode(@_));
86 sub soundex_nara_unicode
88 require Text::Unidecode unless defined &Text::Unidecode::unidecode;
89 soundex_nara(Text::Unidecode::unidecode(@_));
92 eval { XSLoader::load(__PACKAGE__, $VERSION) };
94 if (defined(&soundex_xs)) {
95 *soundex = \&soundex_xs;
97 *soundex = \&soundex_noxs;
100 Carp::croak("XS implementation of Text::Soundex::soundex_xs() ".
101 "could not be loaded");
109 # Implementation of the soundex algorithm.
111 # Some of this documention was written by Mike Stok.
115 # Euler, Ellery -> E460
116 # Gauss, Ghosh -> G200
117 # Hilbert, Heilbronn -> H416
118 # Knuth, Kant -> K530
119 # Lloyd, Ladd -> L300
120 # Lukasiewicz, Lissajous -> L222
125 Text::Soundex - Implementation of the soundex algorithm.
131 # Original algorithm.
132 $code = soundex($name); # Get the soundex code for a name.
133 @codes = soundex(@names); # Get the list of codes for a list of names.
135 # American Soundex variant (NARA) - Used for US census data.
136 $code = soundex_nara($name); # Get the soundex code for a name.
137 @codes = soundex_nara(@names); # Get the list of codes for a list of names.
139 # Redefine the value that soundex() will return if the input string
140 # contains no identifiable sounds within it.
141 $Text::Soundex::nocode = 'Z000';
145 Soundex is a phonetic algorithm for indexing names by sound, as
146 pronounced in English. The goal is for names with the same
147 pronunciation to be encoded to the same representation so that they
148 can be matched despite minor differences in spelling. Soundex is the
149 most widely known of all phonetic algorithms and is often used
150 (incorrectly) as a synonym for "phonetic algorithm". Improvements to
151 Soundex are the basis for many modern phonetic algorithms. (Wikipedia,
154 This module implements the original soundex algorithm developed by
155 Robert Russell and Margaret Odell, patented in 1918 and 1922, as well
156 as a variation called "American Soundex" used for US census data, and
157 current maintained by the National Archives and Records Administration
160 The soundex algorithm may be recognized from Donald Knuth's
161 B<The Art of Computer Programming>. The algorithm described by
162 Knuth is the NARA algorithm.
164 The value returned for strings which have no soundex encoding is
165 defined using C<$Text::Soundex::nocode>. The default value is C<undef>,
166 however values such as C<'Z000'> are commonly used alternatives.
168 For backward compatibility with older versions of this module the
169 C<$Text::Soundex::nocode> is exported into the caller's namespace as
172 In scalar context, C<soundex()> returns the soundex code of its first
173 argument. In list context, a list is returned in which each element is the
174 soundex code for the corresponding argument passed to C<soundex()>. For
175 example, the following code assigns @codes the value C<('M200', 'S320')>:
177 @codes = soundex qw(Mike Stok);
179 To use C<Text::Soundex> to generate codes that can be used to search one
180 of the publically available US Censuses, a variant of the soundex
181 algorithm must be used:
184 $code = soundex_nara($name);
186 An example of where these algorithm differ follows:
189 print soundex("Ashcraft"), "\n"; # prints: A226
190 print soundex_nara("Ashcraft"), "\n"; # prints: A261
194 Donald Knuth's examples of names and the soundex codes they map to
197 Euler, Ellery -> E460
199 Hilbert, Heilbronn -> H416
202 Lukasiewicz, Lissajous -> L222
206 $code = soundex 'Knuth'; # $code contains 'K530'
207 @list = soundex qw(Lloyd Gauss); # @list contains 'L300', 'G200'
211 As the soundex algorithm was originally used a B<long> time ago in the US
212 it considers only the English alphabet and pronunciation. In particular,
213 non-ASCII characters will be ignored. The recommended method of dealing
214 with characters that have accents, or other unicode characters, is to use
215 the Text::Unidecode module available from CPAN. Either use the module
221 print soundex(unidecode("Fran\xE7ais")), "\n"; # Prints "F652\n"
223 Or use the convenient wrapper routine:
225 use Text::Soundex 'soundex_unicode';
227 print soundex_unicode("Fran\xE7ais"), "\n"; # Prints "F652\n"
229 Since the soundex algorithm maps a large space (strings of arbitrary
230 length) onto a small space (single letter plus 3 digits) no inference
231 can be made about the similarity of two strings which end up with the
232 same soundex code. For example, both C<Hilbert> and C<Heilbronn> end
233 up with a soundex code of C<H416>.
237 This module is currently maintain by Mark Mielke (C<mark@mielke.cc>).
241 Version 3 is a significant update to provide support for versions of
242 Perl later than Perl 5.004. Specifically, the XS version of the
243 soundex() subroutine understands strings that are encoded using UTF-8
246 Version 2 of this module was a re-write by Mark Mielke (C<mark@mielke.cc>)
247 to improve the speed of the subroutines. The XS version of the soundex()
248 subroutine was introduced in 2.00.
250 Version 1 of this module was written by Mike Stok (C<mike@stok.co.uk>)
251 and was included into the Perl core library set.
253 Dave Carlsen (C<dcarlsen@csranet.com>) made the request for the NARA
254 algorithm to be included. The NARA soundex page can be viewed at:
255 C<http://www.nara.gov/genealogy/soundex/soundex.html>
257 Ian Phillips (C<ian@pipex.net>) and Rich Pinder (C<rpinder@hsc.usc.edu>)
258 supplied ideas and spotted mistakes for v1.x.