Permalink
Browse files

initial import of Lingua-EN-Inflect-Number 1.0 from CPAN

git-cpan-module:   Lingua-EN-Inflect-Number
git-cpan-version:  1.0
git-cpan-authorid: SIMON
git-cpan-file:     authors/id/S/SI/SIMON/Lingua-EN-Inflect-Number-1.0.tar.gz
  • Loading branch information...
0 parents commit a4d6aa332ca9c7354fc65cbbc35883b91a6f14be Simon Cozens committed with schwern Jan 1, 2004
Showing with 206 additions and 0 deletions.
  1. +6 −0 Changes
  2. +6 −0 MANIFEST
  3. +11 −0 Makefile.PL
  4. +111 −0 Number.pm
  5. +35 −0 README
  6. +37 −0 test.pl
@@ -0,0 +1,6 @@
+Revision history for Perl extension Lingua::EN::Inflect::Number.
+
+0.01 Wed Dec 31 17:24:48 2003
+ - original version; created by h2xs 1.21 with options
+ -AX -n Lingua::EN::Inflect::Number
+
@@ -0,0 +1,6 @@
+Changes
+Makefile.PL
+MANIFEST
+Number.pm
+README
+test.pl
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Lingua::EN::Inflect::Number',
+ 'VERSION_FROM' => 'Number.pm', # finds $VERSION
+ 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'Number.pm', # retrieve abstract from module
+ AUTHOR => 'A. U. Thor <a.u.thor@a.galaxy.far.far.away>') : ()),
+);
111 Number.pm
@@ -0,0 +1,111 @@
+package Lingua::EN::Inflect::Number;
+use 5.006;
+use strict;
+use warnings;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our $VERSION = '1.0';
+our @EXPORT_OK = qw(to_PL to_S number);
+use Lingua::EN::Inflect qw(PL PL_N_eq);
+
+sub import {
+ my ($self, @syms) = @_;
+ # Grep out the ones we provide:
+ my $provide = join "|", map quotemeta, @EXPORT_OK;
+ my @new_syms;
+ for my $sym (@syms) {
+ if ($sym =~ /^\&?($provide)$/) {
+ $self->export_to_level(1, $self, $sym);
+ } else {
+ push @new_syms, $sym;
+ }
+ }
+ return unless @new_syms;
+
+ # Pretend we don't exist
+ @_ = ("Lingua::EN::Inflect", @new_syms);
+ goto &Exporter::import;
+}
+
+sub to_PL {
+ my $word = shift;
+ my $num = number($word);
+ return $word if $num eq "ambig" or $num eq "p";
+ return PL($word);
+}
+
+sub to_S {
+ my $word = shift;
+ my $num = number($word);
+ return $word if $num eq "ambig" or $num eq "s";
+ return PL($word); # I don't know why this works, but it seems to.
+}
+
+sub number {
+ my $word = shift;
+ my $test = PL_N_eq($word, PL($word));
+ $test =~ s/:.*//;
+ $test = "ambig" if $test eq "eq";
+ return $test;
+}
+
+1;
+__END__
+# Below is stub documentation for your module. You better edit it!
+
+=head1 NAME
+
+Lingua::EN::Inflect::Number - Force number of words to singular or plural
+
+=head1 SYNOPSIS
+
+ use Lingua::EN::Inflect::Number qw(
+ number to_S to_PL # Or anything you want from Lingua::EN::Inflect
+ );
+
+ print number("goat"); # "s" - there's only one goat
+ print number("goats"); # "p" - there's several goats
+ print number("sheep"); # "ambig" - there could be one or many sheep
+
+ print to_S("goats"); # "goat"
+ print to_PL("goats"); # "goats" - it already is
+ print to_S("goat"); # "goat" - it already is
+ print to_S("sheep"); # "sheep"
+
+=head1 DESCRIPTION
+
+This module extends the functionality of Lingua::EN::Inflect with three
+new functions available for export:
+
+=head2 number
+
+This takes a word, and determines its number. It returns C<s> for singular,
+C<p> for plural, and C<ambig> for words that can be either singular or plural.
+
+Based on that:
+
+=head2 to_S / to_PL
+
+These take a word and convert it forcefully either to singular or to
+plural. C<Lingua::EN::Inflect> does funny things if you try to pluralise
+an already-plural word, but this module does the right thing.
+
+=head1 DISCLAIMER
+
+The whole concept is based on several undocumented features and
+idiosyncracies in the way Lingua::EN::Inflect works. Because of this,
+the module only works reliably on nouns. It's also possible that these
+idiosyncracies will be fixed at some point in the future and this module
+will need to be rethought. But it works at the moment. Additionally,
+any disclaimers on Lingua::EN::Inflect apply double here.
+
+=head1 AUTHOR
+
+Simon Cozens, C<simon@cpan.org>
+
+=head1 SEE ALSO
+
+L<Lingua::EN::Inflect>.
+
+=cut
35 README
@@ -0,0 +1,35 @@
+Lingua/EN/Inflect/Number version 0.01
+========================================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2003 A. U. Thor blah blah blah
+
37 test.pl
@@ -0,0 +1,37 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 21;
+use Lingua::EN::Inflect::Number (qw( PL_N to_PL to_S number));
+
+ok(*PL_N{CODE}, "Imported something from L::EN::Inflect");
+ok(*to_PL{CODE}, "Imported something from Number");
+
+is(number("goat"), "s", "one goat");
+is(number("goats"), "p", "two goats");
+is(number("sheep"), "ambig", "who knows how many sheep?");
+
+test_all(@$_) for (
+ [ qw( goat goats )],
+ [ qw( brewery breweries )],
+ [ qw( beer beers )],
+ [ qw( sheep sheep )],
+ );
+
+sub test_all {
+ my ($s, $p) = @_;
+ is( to_S($p), $s, "$p to singular is $s");
+ is( to_S($s), $s, "$s is already singular");
+ is( to_PL($s), $p, "Force $s to plural");
+ is( to_PL($p), $p, "Force $p to plural");
+}
+
+#########################
+
+# Insert your test code below, the Test module is use()ed here so read
+# its man page ( perldoc Test ) for help writing this test script.
+

0 comments on commit a4d6aa3

Please sign in to comment.