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 cond sub pod time code
1             package Locale::TextDomain::OO::TiedInterface; ## no critic (TidyCode)
2            
3 2     2   7288 use strict;
  2         7  
  2         92  
4 2     2   16 use warnings;
  2         5  
  2         96  
5            
6             our $VERSION = '1.014';
7            
8 2     2   13 use Carp qw(confess);
  2         4  
  2         129  
9 2     2   976 use Tie::Sub;
  2         4799  
  2         571  
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   2455 my (undef, @imports) = @_;
190            
191 4 100       15 if (! @imports) {
192             @imports = (
193             qw($loc_ref),
194 1         20 map { ("\%$_", "\$$_") } keys %method_name,
  164         340  
195             );
196             }
197            
198 4         20 my $caller = caller;
199 4         133 my $package = __PACKAGE__;
200            
201             IMPORT:
202 4         12 for my $import (@imports) {
203 332 100       13140 defined $import
204             or confess 'An undefined value is not a variable name';
205 331 100       639 if ($import eq '$loc_ref') { ## no critic (InterpolationOfMetachars)
206 2     2   30 no strict qw(refs); ## no critic (NoStrict)
  2         4  
  2         106  
207 2     2   14 no warnings qw(redefine); ## no critic (NoWarnings)
  2         5  
  2         455  
208 1         3 *{"$caller\::loc_ref"} = \$loc_ref;
  1         6  
209 1         3 next IMPORT;
210             }
211 330 100       1602 (my $method = $import) =~ s{\A (?: (\$) | % )}{}xms
212             or confess qq{"$import" is not a hash or a hash reference};
213 329         746 my $is_ref = $1;
214 329 100       767 exists $method_name{$method}
215             or confess qq{"$import" is not exported};
216             {
217 2     2   20 no strict qw(refs); ## no critic (NoStrict)
  2         14  
  2         106  
  328         485  
218 2     2   14 no warnings qw(redefine); ## no critic (NoWarnings)
  2         7  
  2         396  
219 328         1132 *{"$caller\::$method"}
220             = $is_ref
221 164         530 ? \${"$package\::$method"}
222 328 100       604 : \%{"$package\::$method"};
  164         822  
223             }
224             my $sub
225             = ( index $method, 'N', 0 ) == 0
226             ? sub {
227 6     6   5488 return [ ${$loc_ref}->$method(@_) ];
  6         33  
228             }
229             : sub {
230 12     12   10144 return ${$loc_ref}->$method(@_);
  12         83  
231 328 100       1702 };
232 328 100       696 if ($is_ref) {
233 2     2   17 no strict qw(refs); ## no critic (NoStrict)
  2         4  
  2         163  
234             tie ## no critic (Ties)
235 164         221 %{ ${$method} },
  164         210  
  164         680  
236             'Tie::Sub',
237             $sub;
238             }
239             else {
240 2     2   18 no strict qw(refs); ## no critic (NoStrict)
  2         5  
  2         262  
241             tie ## no critic (Ties)
242 164         226 %{$method},
  164         618  
243             'Tie::Sub',
244             $sub;
245             }
246             }
247            
248 1         118666 return;
249             }
250            
251             1;
252            
253             __END__