File Coverage

blib/lib/Lingua/PigLatin/Bidirectional.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	8	8	100.0
condition			n/a
subroutine	7	7	100.0
pod	2	2	100.0
total	47	47	100.0

package Lingua::PigLatin::Bidirectional;
use 5.008005;
use strict;
use warnings;
use utf8;

use base qw(Exporter);
our @EXPORT = qw(to_piglatin from_piglatin);

our $VERSION = "0.01";

sub to_piglatin {
    my $str = shift;

    $str =~ s{\b                 # See if each given word starts w/ or w/o
                ( qu             # 1. qu (e.g. question => estionquay)
                | [cgpstw]h      # 2. digraphs
                | [^\W0-9_aeiou] # 3. any "word" character other than
                                 #    0-9, _ and vowels
                )?
                ( [a-z]+ )       # and then alphabet character(s)
            }
            {
                if ( my $pre = $1 ) {
                    # if the first rule applies, append former part and add -ay
                    my $post = $2;
                    $pre =~ /\A [A-Z]/x
                        ? ucfirst($post) . lcfirst($pre) . 'ay'
                        : $post . $pre . 'ay' ;
                }
                else {
                    # otherwise add -way
                    $2 . 'way';
                }
            }iegxms;

    return $str;
}

sub from_piglatin {
    my $str = shift;

    $str =~ s{                  # See if each given word consists of...
               ( [a-z]+ )way    # alphabet character(s) followed by "way"
             |                  # OR...
               ( [a-z]+? )      # zero or alphabet character(s) followed by...
               ( qu             # 1. qu
               | [cgpstw]h      # 2. digraphs
               | [^\W0-9_aeiou] # 3. any "word" character other than
                                #    0-9, _ and vowels
               )ay              # and trailing "ay"
            \b}
            {
                if ($1) {
                    $1;
                }
                else {
                    my $pre  = $2;
                    my $post = $3;
                    $pre =~ m/\A [A-Z]/x
                        ? ucfirst($post) . lcfirst($pre)
                        : $post . $pre ;
                }
            }iegxms;

    return $str;
}

1;
__END__