1N/Apackage Text::Soundex;
1N/Arequire 5.000;
1N/Arequire Exporter;
1N/A
1N/A@ISA = qw(Exporter);
1N/A@EXPORT = qw(&soundex $soundex_nocode);
1N/A
1N/A$VERSION = '1.01';
1N/A
1N/A# $Id: soundex.pl,v 1.2 1994/03/24 00:30:27 mike Exp $
1N/A#
1N/A# Implementation of soundex algorithm as described by Knuth in volume
1N/A# 3 of The Art of Computer Programming, with ideas stolen from Ian
1N/A# Phillipps <ian@pipex.net>.
1N/A#
1N/A# Mike Stok <Mike.Stok@meiko.concord.ma.us>, 2 March 1994.
1N/A#
1N/A# Knuth's test cases are:
1N/A#
1N/A# Euler, Ellery -> E460
1N/A# Gauss, Ghosh -> G200
1N/A# Hilbert, Heilbronn -> H416
1N/A# Knuth, Kant -> K530
1N/A# Lloyd, Ladd -> L300
1N/A# Lukasiewicz, Lissajous -> L222
1N/A#
1N/A# $Log: soundex.pl,v $
1N/A# Revision 1.2 1994/03/24 00:30:27 mike
1N/A# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
1N/A# in the way I handles leasing characters which were different but had
1N/A# the same soundex code. This showed up comparing it with Oracle's
1N/A# soundex output.
1N/A#
1N/A# Revision 1.1 1994/03/02 13:01:30 mike
1N/A# Initial revision
1N/A#
1N/A#
1N/A##############################################################################
1N/A
1N/A# $soundex_nocode is used to indicate a string doesn't have a soundex
1N/A# code, I like undef other people may want to set it to 'Z000'.
1N/A
1N/A$soundex_nocode = undef;
1N/A
1N/Asub soundex
1N/A{
1N/A local (@s, $f, $fc, $_) = @_;
1N/A
1N/A push @s, '' unless @s; # handle no args as a single empty string
1N/A
1N/A foreach (@s)
1N/A {
1N/A $_ = uc $_;
1N/A tr/A-Z//cd;
1N/A
1N/A if ($_ eq '')
1N/A {
1N/A $_ = $soundex_nocode;
1N/A }
1N/A else
1N/A {
1N/A ($f) = /^(.)/;
1N/A tr/AEHIOUWYBFPVCGJKQSXZDTLMNR/00000000111122222222334556/;
1N/A ($fc) = /^(.)/;
1N/A s/^$fc+//;
1N/A tr///cs;
1N/A tr/0//d;
1N/A $_ = $f . $_ . '000';
1N/A s/^(.{4}).*/$1/;
1N/A }
1N/A }
1N/A
1N/A wantarray ? @s : shift @s;
1N/A}
1N/A
1N/A1;
1N/A
1N/A__END__
1N/A
1N/A=head1 NAME
1N/A
1N/AText::Soundex - Implementation of the Soundex Algorithm as Described by Knuth
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A use Text::Soundex;
1N/A
1N/A $code = soundex $string; # get soundex code for a string
1N/A @codes = soundex @list; # get list of codes for list of strings
1N/A
1N/A # set value to be returned for strings without soundex code
1N/A
1N/A $soundex_nocode = 'Z000';
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AThis module implements the soundex algorithm as described by Donald Knuth
1N/Ain Volume 3 of B<The Art of Computer Programming>. The algorithm is
1N/Aintended to hash words (in particular surnames) into a small space using a
1N/Asimple model which approximates the sound of the word when spoken by an English
1N/Aspeaker. Each word is reduced to a four character string, the first
1N/Acharacter being an upper case letter and the remaining three being digits.
1N/A
1N/AIf there is no soundex code representation for a string then the value of
1N/AC<$soundex_nocode> is returned. This is initially set to C<undef>, but
1N/Amany people seem to prefer an I<unlikely> value like C<Z000>
1N/A(how unlikely this is depends on the data set being dealt with.) Any value
1N/Acan be assigned to C<$soundex_nocode>.
1N/A
1N/AIn scalar context C<soundex> returns the soundex code of its first
1N/Aargument, and in list context a list is returned in which each element is the
1N/Asoundex code for the corresponding argument passed to C<soundex> e.g.
1N/A
1N/A @codes = soundex qw(Mike Stok);
1N/A
1N/Aleaves C<@codes> containing C<('M200', 'S320')>.
1N/A
1N/A=head1 EXAMPLES
1N/A
1N/AKnuth's examples of various names and the soundex codes they map to
1N/Aare listed below:
1N/A
1N/A Euler, Ellery -> E460
1N/A Gauss, Ghosh -> G200
1N/A Hilbert, Heilbronn -> H416
1N/A Knuth, Kant -> K530
1N/A Lloyd, Ladd -> L300
1N/A Lukasiewicz, Lissajous -> L222
1N/A
1N/Aso:
1N/A
1N/A $code = soundex 'Knuth'; # $code contains 'K530'
1N/A @list = soundex qw(Lloyd Gauss); # @list contains 'L300', 'G200'
1N/A
1N/A=head1 LIMITATIONS
1N/A
1N/AAs the soundex algorithm was originally used a B<long> time ago in the US
1N/Ait considers only the English alphabet and pronunciation.
1N/A
1N/AAs it is mapping a large space (arbitrary length strings) onto a small
1N/Aspace (single letter plus 3 digits) no inference can be made about the
1N/Asimilarity of two strings which end up with the same soundex code. For
1N/Aexample, both C<Hilbert> and C<Heilbronn> end up with a soundex code
1N/Aof C<H416>.
1N/A
1N/A=head1 AUTHOR
1N/A
1N/AThis code was implemented by Mike Stok (C<stok@cybercom.net>) from the
1N/Adescription given by Knuth. Ian Phillipps (C<ian@pipex.net>) and Rich Pinder
1N/A(C<rpinder@hsc.usc.edu>) supplied ideas and spotted mistakes.