Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Split language data into individual files

Also provides langs() and languages() for language codes and
language names respectively.
  • Loading branch information...
commit bce89cf82db2852ccc71328ef8841d9a316a3960 1 parent a5c8afc
@doherty authored
View
6 README
@@ -17,7 +17,7 @@ SYNOPSIS
# Once more, with feeling
print "Fait-le? ";
- chomp(my $response = <>);
+ chomp($response = <>);
if ( boolean $response, 'fr' ) { # OUI
print "OK, on le fait.\n";
}
@@ -39,6 +39,10 @@ FUNCTIONS
languages
"languages()" returns the list of languages Lingua::Boolean knows about.
+ langs
+ "langs()" returns the list of language codes Lingua::Boolean knows
+ about.
+
looks_true
"looks_true()" tells you whether Lingua::Boolean thinks the thing looks
true. By default, it uses *en*; pass a language code as the second
View
57 lib/Lingua/Boolean.pm
@@ -22,7 +22,7 @@ use boolean 0.21 qw(true false);
# Once more, with feeling
print "Fait-le? ";
- chomp(my $response = <>);
+ chomp($response = <>);
if ( boolean $response, 'fr' ) { # OUI
print "OK, on le fait.\n";
}
@@ -49,14 +49,28 @@ imported.
use Exporter qw(import);
our @EXPORT = qw(boolean); # EXPORTS
-our @EXPORT_OK = qw(looks_true looks_false languages);
-
-my $langs; # PATCHES WELCOME
-$langs->{en}->{yes} = [qr{^y(?:es)?$}i, qr{^on$}i, qr{^ok$}i, qr{^[1-9]$}];
-$langs->{en}->{no} = [qr{^no?$}i, qr{^off$}i, qr{not ?ok$}i, qr{^0$}];
-
-$langs->{fr}->{yes} = [qr{^oui$}i, qr{^ok$}i, qr{^[1-9]$}];
-$langs->{fr}->{no} = [qr{^n(?:on?)?$}i, qr{^0$}];
+our @EXPORT_OK = qw(looks_true looks_false languages langs);
+
+use Module::Pluggable search_path => [__PACKAGE__], require => 1;
+my $regexes;
+my $languages;
+foreach my $language ( __PACKAGE__->plugins() ) {
+ my $l = do {
+ no strict qw(refs); ## no critic (ProhibitNoStrict)
+ ${ $language . '::LANG' };
+ };
+ my $l_long = do {
+ no strict qw(refs); ## no critic (ProhibitNoStrict)
+ ${ $language . '::LANGUAGE' };
+ };
+ $languages->{$l} = $l_long;
+
+ my $r = do {
+ no strict qw(refs); ## no critic (ProhibitNoStrict)
+ ${ $language . '::match' };
+ };
+ $regexes->{$l} = $r;
+}
=head2 languages
@@ -65,7 +79,22 @@ C<languages()> returns the list of languages L<Lingua::Boolean> knows about.
=cut
sub languages {
- return keys %$langs;
+ my @long_names;
+ foreach my $l (keys %$languages) {
+ push @long_names, $languages->{$l};
+ }
+ return @long_names;
+}
+
+=head2 langs
+
+C<langs()> returns the list of language codes L<Lingua::Boolean> knows about.
+
+=cut
+
+sub langs {
+ my @lang_codes = keys %$languages;
+ return @lang_codes;
}
=head2 looks_true
@@ -80,8 +109,8 @@ sub looks_true {
my $to_test = shift;
my $lang = shift || 'en';
- croak "I don't know anything about the language '$lang'" unless exists $langs->{$lang};
- return true if ($to_test ~~ $langs->{$lang}->{yes});
+ croak "I don't know anything about the language '$lang'" unless exists $regexes->{$lang};
+ return true if ($to_test ~~ $regexes->{$lang}->{True});
return false;
}
@@ -97,8 +126,8 @@ sub looks_false {
my $to_test = shift;
my $lang = shift || 'en';
- croak "I don't know anything about the language '$lang'" unless exists $langs->{$lang};
- return true if ($to_test ~~ $langs->{$lang}->{no});
+ croak "I don't know anything about the language '$lang'" unless exists $regexes->{$lang};
+ return true if ($to_test ~~ $regexes->{$lang}->{False});
return false;
}
View
16 lib/Lingua/Boolean/English.pm
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use utf8;
+package Lingua::Boolean::English;
+# ABSTRACT: provides English to Lingua::Boolean
+
+our $LANG = 'en';
+our $LANGUAGE = 'English';
+
+our $match;
+$match->{True} = [qr{^y(?:es)?$}i, qr{^on$}i, qr{^ok$}i, qr{^[1-9]$}];
+$match->{False} = [qr{^no?$}i, qr{^off$}i, qr{not ?ok$}i, qr{^0$}];
+
+1;
+
+__END__
View
22 lib/Lingua/Boolean/French.pm
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+use utf8;
+package Lingua::Boolean::French;
+# ABSTRACT: provides French to Lingua::Boolean
+
+=head1 DESCRIPTION
+
+This module provides rules for French to L<Lingua::Boolean>.
+
+=cut
+
+our $LANG = 'fr';
+our $LANGUAGE = 'Français';
+
+our $match;
+$match->{True} = [qr{^oui$}i, qr{^ok$}i, qr{^[1-9]$}];
+$match->{False} = [qr{^n(?:on?)?$}i, qr{^0$}];
+
+1;
+
+__END__
View
25 t/00-init.t
@@ -1,9 +1,28 @@
use strict;
use warnings;
-use Test::More 0.75 tests => 2;
+use utf8;
+use Test::More 0.75 tests => 4;
BEGIN {
- use_ok('Lingua::Boolean', qw(boolean looks_true looks_false languages));
+ use_ok('Lingua::Boolean', qw(boolean looks_true looks_false languages langs));
}
-can_ok('Lingua::Boolean', qw(boolean looks_true looks_false languages));
+can_ok('Lingua::Boolean', qw(boolean looks_true looks_false languages langs));
+
+{ # Language codes
+ my @has = langs();
+ my @should_have = (
+ 'en',
+ 'fr',
+ );
+ is_deeply(\@has, \@should_have, 'Available language codes OK');
+}
+
+{ # Languages names
+ my @has = languages();
+ my @should_have = (
+ 'English',
+ 'Français',
+ );
+ is_deeply(\@has, \@should_have, 'Available language names OK');
+}
View
4 t/lang/en.t
@@ -7,8 +7,8 @@ use Lingua::Boolean;
my $lang = 'en';
-my @languages = Lingua::Boolean::languages();
-ok($lang ~~ @languages, "$lang is available");
+my @langs = Lingua::Boolean::langs();
+ok($lang ~~ @langs, "$lang is available");
subtest 'yes' => sub { #YES
my @yes = ('y', 'yes', 'ok', 'on', 'Y', 'YES', 'OK', 'ON', 1, 2);
View
4 t/lang/fr.t
@@ -7,8 +7,8 @@ use Lingua::Boolean;
my $lang = 'fr';
-my @languages = Lingua::Boolean::languages();
-ok($lang ~~ @languages, "$lang is available");
+my @langs = Lingua::Boolean::langs();
+ok($lang ~~ @langs, "$lang is available");
subtest 'yes' => sub { #YES
my @yes = ('oui', 'ok', 1);
Please sign in to comment.
Something went wrong with that request. Please try again.