File Coverage

blib/lib/Lingua/EN/ABC.pm
Criterion Covered Total %
statement 51 57 89.4
branch 10 16 62.5
condition n/a
subroutine 11 11 100.0
pod 6 6 100.0
total 78 90 86.6


line stmt bran cond sub pod time code
1             package Lingua::EN::ABC;
2             require Exporter;
3             @ISA = qw(Exporter);
4             @EXPORT_OK = qw/a2b b2a a2c c2a b2c c2b/;
5             %EXPORT_TAGS = (
6             all => \@EXPORT_OK,
7             );
8 1     1   90528 use warnings;
  1         3  
  1         33  
9 1     1   6 use strict;
  1         2  
  1         19  
10 1     1   5 use Carp;
  1         1  
  1         65  
11 1     1   473 use JSON::Parse 'read_json';
  1         1371  
  1         63  
12 1     1   459 use Convert::Moji 'make_regex';
  1         2042  
  1         892  
13              
14             our $VERSION = '0.11_01';
15              
16             # Load the data from the file.
17              
18             my $json = __FILE__;
19             $json =~ s!\.pm$!/abc.json!;
20             my $abc = read_json ($json);
21              
22             # American
23             my @a;
24             my @as;
25             # British
26             my @b;
27             my @bs;
28             # Canadian
29             my @c;
30             my @cs;
31             # British Oxford
32             my @bo;
33             # Map from either American or British version to its entry
34             my %any2e;
35             for my $e (@$abc) {
36             $any2e{$e->{a}} = $e;
37             $any2e{$e->{b}} = $e;
38             push @a, $e->{a};
39             push @b, $e->{b};
40             # co is "Canadian output".
41             if ($e->{ca}) {
42             $e->{co} = $e->{a};
43             }
44             else {
45             $e->{co} = $e->{b};
46             }
47             # bo is "British Oxford".
48             if ($e->{oxford}) {
49             $e->{bo} = $e->{a};
50             }
51             else {
52             $e->{bo} = $e->{b};
53             }
54             # ao is "American output".
55             if ($e->{aam}) {
56             $e->{ao} = "$e->{a}/$e->{b}";
57             }
58             else {
59             $e->{ao} = $e->{a};
60             }
61             }
62              
63             for my $k (keys %any2e) {
64             my $e = $any2e{$k};
65             if ($e->{s} && ! ($e->{bam} || $e->{aam})) {
66             push @as, $e->{a};
67             push @bs, $e->{b};
68             }
69             }
70              
71             # Word-matching regexes
72              
73             my $a_re = make_regex (@a);
74             my $b_re = make_regex (@b);
75             my $bo_re = make_regex (@bo);
76             my $as_re = make_regex (@as);
77             my $bs_re = make_regex (@bs);
78              
79             sub a2b
80             {
81 10     10 1 8729 my ($text, %options) = @_;
82 10         20 my $re = $a_re;
83 10         14 my $out = 'b';
84 10 100       28 if ($options{oxford}) {
85 1         2 $out = 'bo';
86             }
87 10 100       24 if ($options{s}) {
88 2         3 $re = $as_re;
89             }
90 10         2375 $text =~ s/\b($re)(s?)\b/$any2e{$1}{$out}$3/g;
91 10         54 return $text;
92             }
93              
94             sub b2a
95             {
96 2     2 1 1054 my ($text, %options) = @_;
97 2         4 my $re = $b_re;
98 2 50       8 if ($options{s}) {
99 0         0 $re = $bs_re;
100             }
101 2         614 $text =~ s/\b($re)(s?)\b/$any2e{$1}{ao}$3/g;
102 2         12 return $text;
103             }
104              
105             sub a2c
106             {
107 1     1 1 577 my ($text, %options) = @_;
108 1         2 my $re = $a_re;
109 1 50       7 if ($options{s}) {
110 0         0 $re = $as_re;
111             }
112 1         613 $text =~ s/\b($re)(s?)\b/$any2e{$1}{co}$3/g;
113 1         8 return $text;
114             }
115              
116             sub c2a
117             {
118 1     1 1 492 my ($text, %options) = @_;
119 1         3 my $re = $b_re;
120 1 50       4 if ($options{s}) {
121 0         0 $re = $bs_re;
122             }
123 1         679 $text =~ s/\b($re)(s?)\b/$any2e{$1}{ao}$3/g;
124 1         8 return $text;
125             }
126              
127             sub c2b
128             {
129 1     1 1 611 my ($text, %options) = @_;
130 1         3 my $type = 'b';
131 1 50       4 if ($options{oxford}) {
132 0         0 $type = 'bo';
133             }
134 1         3 my $re = $a_re;
135 1 50       3 if ($options{s}) {
136 0         0 $re = $as_re;
137             }
138 1         626 $text =~ s/\b($re)(s?)\b/$any2e{$1}{$type}$3/g;
139 1         8 return $text;
140             }
141              
142             sub b2c
143             {
144 1     1 1 555 my ($text, %options) = @_;
145 1         2 my $re = $b_re;
146 1 50       4 if ($options{s}) {
147 0         0 $re = $bs_re;
148             }
149 1         652 $text =~ s/\b($re)(s?)\b/$any2e{$1}{co}$3/g;
150 1         8 return $text;
151             }
152              
153             1;