Andrew Gaffney wrote:
Wow, this is more difficult than I first thought.
Not really. Just for kicks here is a simple driver:
#!/usr/bin/perl
use strict;
use warnings;
use Leetspeak;
# $Leetspeak::DEBUG = 1;
my $word = shift( @ARGV );
my $l33t = Leetspeak->new();
my $translation = $l33t->translate( $word );
if ( $translation ) {
print "$word => ", $translation , "\n";
} else {
print "not found\n";
}
__END__
for the following module:
package Leetspeak;
use strict;
use warnings;
our $DEBUG = 0;
sub new {
my $package = shift;
my %args = @_;
my $dict =
(grep defined && -e, ( $args{dict}, '/usr/share/dict/words' ))[0];
my %data = ( dict => $dict );
my $self = bless( \%data, $package );
$self->_read_dict();
return $self;
}
{
my %trans_tbl = (
'@' => [ 'A' ],
'$' => [ 'S' ],
'+' => [ 'T' ],
'0' => {
'0' => [ 'O' ],
'0r' => [ 'ER' ],
},
'1' => [ 'I', 'L' ],
'2' => [ 'Z' ],
'3' => {
'3' => [ 'E' ],
'3y3' => [ 'I' ],
},
'4' => [ 'A' ],
'5' => [ 'S', 'Z' ],
'6' => [ 'B', 'G' ],
'7' => [ 'T' ],
'8' => [ 'B' ],
'9' => [ 'P', 'Q' ],
'l' => [ 'I' ],
'p' => {
'p' => [ 'O' ],
'ph' => [ 'F' ],
},
'x' => [ 'CK', 'CKS' ],
'z' => [ 'S' ],
);
sub translate {
my $self = shift;
my $word = shift;
my $start = shift || 0;
print "translate( $word, $start )\n" if $DEBUG;
return $word if $self->_has_word( $word );
for my $i ( $start .. length( $word ) - 1 ) {
my $ch = substr( $word, $i, 1 );
next unless exists( $trans_tbl{$ch} );
my $trans = ( ref( $trans_tbl{$ch} ) eq 'HASH' ) ?
$trans_tbl{$ch} : { $ch => $trans_tbl{$ch} };
foreach my $key ( keys( %$trans ) ) {
my $key_len = length( $key );
if ( substr( $word, $i, $key_len ) eq $key ) {
foreach my $tr ( @{ $trans->{$key} } ) {
print "substr( $word, $i, 1 ) = $tr\n" if $DEBUG;
my $new_word = $word;
substr( $new_word, $i, $key_len ) = $tr;
$new_word = lc( $new_word );
my $offset = $key_len - length( $tr );
$offset ||= 1;
my $result =
$self->translate( $new_word, $i + $offset );
return $result if $result;
}
}
}
}
return undef;
}
}
sub dict { return $_[0]->{dict} }
sub _read_dict {
my $self = shift;
my %words;
open( my $fh, '<', $self->{dict} ) or die $!;
while (defined( my $word = <$fh> )) {
chomp( $word );
$words{$word} = 1;
}
close( $fh );
$self->{words} = \%words;
return scalar %words;
}
sub _has_word {
my $self = shift;
my $word = shift;
return 1 if exists( $self->{words}{$word} );
}
1;
__END__
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
