ch12.079_best

Perl Best Practices the source code

##############################################################################
##   Code fragment (Recommended) from Chapter 12 of "Perl Best Practices"   ##
##     Copyright (c) O'Reilly & Associates, 2005. All Rights Reserved.      ##
##  See: http://www.oreilly.com/pub/a/oreilly/ask_tim/2001/codepolicy.html  ##
##############################################################################


# Standard modules...
use strict;
use warnings;
use IO::Prompt;
use Carp;
use English qw( -no_match_vars );
use Data::Alias;
use Readonly;


# Build a pattern matching any of the arguments given...
sub regex_that_matches {
    return join '|',
                map {quotemeta $_}
                    # longest strings first, otherwise alphabetically...
                    sort { length($b) <=> length($a) or $a cmp $b } 
                         @_;
}
 
# and later...
 

# Table of irregular plurals...
my %irregular_plural_of = (
    'child'       => 'children',
    'brother'     => 'brethren',
    'money'       => 'monies',
    'mongoose'    => 'mongooses',
    'ox'          => 'oxen',
    'cow'         => 'kine',
    'soliloquy'   => 'soliloquies',
    'prima donna' => 'prime donne',
    'octopus'     => 'octopodes',
    'tooth'       => 'teeth',
    'toothfish'   => 'toothfish',
);
 
# Pattern matching any of those irregular plurals...
my $has_irregular_plural  
    = regex_that_matches(keys %irregular_plural_of);

 
# Form plurals...
while (my $word = <DATA>) {
    chomp $word;
    if ($word =~ m/ ($has_irregular_plural) /xms) {
        print $irregular_plural_of{$word}, "\n";
    }
    else {
        print form_regular_plural_of($word), "\n";
    }
}


sub form_regular_plural_of {
    my ($word) = @_;
    return $word.'s';
}

__DATA__
cat
dog
money
mongoose
tooth