File Coverage

blib/lib/Locale/TextDomain/OO/TiedInterface.pm

Criterion	Covered	Total	%
statement	62	62	100.0
branch	16	16	100.0
condition			n/a
subroutine	13	13	100.0
pod			n/a
total	91	91	100.0

line	stmt	bran	sub	time	code
1					package Locale::TextDomain::OO::TiedInterface; ## no critic (TidyCode)
2
3	2		2	5935	use strict;
	2			4
	2			51
4	2		2	9	use warnings;
	2			4
	2			74
5
6					our $VERSION = '1.014';
7
8	2		2	9	use Carp qw(confess);
	2			4
	2			76
9	2		2	687	use Tie::Sub;
	2			3807
	2			407
10
11					my %method_name = map { $_ => undef } qw(
12					loc_begin_d
13					loc_begin_c
14					loc_begin_dc
15					loc_end_d
16					loc_end_c
17					loc_end_dc
18					loc_
19					loc_x
20					loc_n
21					loc_nx
22					loc_p
23					loc_px
24					loc_np
25					loc_npx
26					loc_d
27					loc_dx
28					loc_dn
29					loc_dnx
30					loc_dp
31					loc_dpx
32					loc_dnp
33					loc_dnpx
34					loc_c
35					loc_cx
36					loc_cn
37					loc_cnx
38					loc_cp
39					loc_cpx
40					loc_cnp
41					loc_cnpx
42					loc_dc
43					loc_dcx
44					loc_dcn
45					loc_dcnx
46					loc_dcp
47					loc_dcpx
48					loc_dcnp
49					loc_dcnpx
50
51					Nloc_
52					Nloc_x
53					Nloc_n
54					Nloc_nx
55					Nloc_p
56					Nloc_px
57					Nloc_np
58					Nloc_npx
59					Nloc_d
60					Nloc_dx
61					Nloc_dn
62					Nloc_dnx
63					Nloc_dp
64					Nloc_dpx
65					Nloc_dnp
66					Nloc_dnpx
67					Nloc_c
68					Nloc_cx
69					Nloc_cn
70					Nloc_cnx
71					Nloc_cp
72					Nloc_cpx
73					Nloc_cnp
74					Nloc_cnpx
75					Nloc_dc
76					Nloc_dcx
77					Nloc_dcn
78					Nloc_dcnx
79					Nloc_dcp
80					Nloc_dcpx
81					Nloc_dcnp
82					Nloc_dcnpx
83
84					__begin_d
85					__begin_c
86					__begin_dc
87					__end_d
88					__end_c
89					__end_dc
90					__
91					__x
92					__n
93					__nx
94					__p
95					__px
96					__np
97					__npx
98					__d
99					__dx
100					__dn
101					__dnx
102					__dp
103					__dpx
104					__dnp
105					__dnpx
106					__c
107					__cx
108					__cn
109					__cnx
110					__cp
111					__cpx
112					__cnp
113					__cnpx
114					__dc
115					__dcx
116					__dcn
117					__dcnx
118					__dcp
119					__dcpx
120					__dcnp
121					__dcnpx
122
123					N__
124					N__x
125					N__n
126					N__nx
127					N__p
128					N__px
129					N__np
130					N__npx
131					N__d
132					N__dx
133					N__dn
134					N__dnx
135					N__dp
136					N__dpx
137					N__dnp
138					N__dnpx
139					N__c
140					N__cx
141					N__cn
142					N__cnx
143					N__cp
144					N__cpx
145					N__cnp
146					N__cnpx
147					N__dc
148					N__dcx
149					N__dcn
150					N__dcnx
151					N__dcp
152					N__dcpx
153					N__dcnp
154					N__dcnpx
155
156					locn
157					Nlocn
158
159					maketext
160					maketext_p
161					Nmaketext
162					Nmaketext_p
163
164					loc
165					loc_m
166					loc_mp
167					Nloc
168					Nloc_m
169					Nloc_mp
170
171					localise
172					localise_m
173					localise_mp
174					Nlocalise
175					Nlocalise_m
176					Nlocalise_mp
177
178					localize
179					localize_m
180					localize_mp
181					Nlocalize
182					Nlocalize_m
183					Nlocalize_mp
184					);
185
186					our $loc_ref = do { my $loc; \$loc }; ## no critic(PackageVars)
187
188					sub import {
189	4		4	1966	my (undef, @imports) = @_;
190
191	4	100		10	if (! @imports) {
192					@imports = (
193					qw($loc_ref),
194	1			16	map { ("\%$_", "\$$_") } keys %method_name,
	164			264
195					);
196					}
197
198	4			15	my $caller = caller;
199	4			108	my $package = __PACKAGE__;
200
201					IMPORT:
202	4			7	for my $import (@imports) {
203	332	100		10205	defined $import
204					or confess 'An undefined value is not a variable name';
205	331	100		512	if ($import eq '$loc_ref') { ## no critic (InterpolationOfMetachars)
206	2		2	15	no strict qw(refs); ## no critic (NoStrict)
	2			4
	2			59
207	2		2	16	no warnings qw(redefine); ## no critic (NoWarnings)
	2			4
	2			262
208	1			2	*{"$caller\::loc_ref"} = \$loc_ref;
	1			4
209	1			2	next IMPORT;
210					}
211	330	100		1190	(my $method = $import) =~ s{\A (?: (\$) \| % )}{}xms
212					or confess qq{"$import" is not a hash or a hash reference};
213	329			594	my $is_ref = $1;
214	329	100		570	exists $method_name{$method}
215					or confess qq{"$import" is not exported};
216					{
217	2		2	12	no strict qw(refs); ## no critic (NoStrict)
	2			4
	2			66
	328			372
218	2		2	11	no warnings qw(redefine); ## no critic (NoWarnings)
	2			4
	2			277
219	328			840	*{"$caller\::$method"}
220					= $is_ref
221	164			394	? \${"$package\::$method"}
222	328	100		475	: \%{"$package\::$method"};
	164			614
223					}
224					my $sub
225					= ( index $method, 'N', 0 ) == 0
226					? sub {
227	6		6	4110	return [ ${$loc_ref}->$method(@_) ];
	6			22
228					}
229					: sub {
230	12		12	7809	return ${$loc_ref}->$method(@_);
	12			50
231	328	100		1225	};
232	328	100		514	if ($is_ref) {
233	2		2	12	no strict qw(refs); ## no critic (NoStrict)
	2			4
	2			120
234					tie ## no critic (Ties)
235	164			198	%{ ${$method} },
	164			176
	164			515
236					'Tie::Sub',
237					$sub;
238					}
239					else {
240	2		2	13	no strict qw(refs); ## no critic (NoStrict)
	2			3
	2			189
241					tie ## no critic (Ties)
242	164			184	%{$method},
	164			500
243					'Tie::Sub',
244					$sub;
245					}
246					}
247
248	1			85552	return;
249					}
250
251					1;
252
253					__END__