File Coverage

blib/lib/Text/MultiPhone.pm

Criterion	Covered	Total	%
statement	42	49	85.7
branch	3	6	50.0
condition			n/a
subroutine	7	12	58.3
pod	0	7	0.0
total	52	74	70.2

package Text::MultiPhone;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.01';

use constant VOWELS => [qw(a e i o u)];

sub new {
    my ($class) = @_;
    return bless {}, $class;
}

sub multiphone {
    my ($self, $word) = @_;
    $word = $self->pre_split($word);
    my @words = $self->do_split($word);
    @words = $self->process_bits(@words);
    @words = $self->do_join(@words);
    @words = $self->post_join(@words);
    return @words;
}

sub _warn {
    my ($self, @warn) = @_;
    warn (@warn);
}

sub pre_split {
    $_[0]->_warn((caller(0))[3] . " not defined in $_[0]\n");
}

# a word consist of 2 levels of arrays
# 1. level splits vowels and consonants
# 2. level splits several meanings of this vowel or consonant
# i.e. Alphabet will be [[a],[lf],[a], [b], [t] ]
sub do_split {
    my ($self, @words) = @_;
    my @results;
    my $vowels = join "", @{ $self->VOWELS() };
    foreach my $word (@words) {
	my @splitted;
	while ($word =~ m/([$vowels]*)([^$vowels]*)/g) {
	    push @splitted, [$1], [$2];
	}
	push @results, \@splitted;
    }
    return @results;
}

sub process_bits {
    $_[0]->_warn((caller(0))[3] . " not defined in $_[0]\n");
}

sub do_join {
    my ($self, @words) = @_;
    my @results = ("");
    foreach my $word (@words) {
	next unless defined $word;
	foreach my $part (@$word) {
	    next unless defined $part;
	    my @newResults;
	    foreach my $splitPart (@$part) {
		next unless defined $splitPart;
		foreach my $result (@results) {
		    push @newResults, $result . $splitPart;
		}
	    }
	    @results = @newResults;
	}
    }
    return @results;
}

sub post_join {
    $_[0]->_warn((caller(0))[3] . " not defined in $_[0]\n");
}


1;
__END__