File Coverage

blib/lib/Data/Object/Name.pm
Criterion Covered Total %
statement 68 71 95.7
branch 8 14 57.1
condition 1 2 50.0
subroutine 16 16 100.0
pod 12 12 100.0
total 105 115 91.3


line stmt bran cond sub pod time code
1             package Data::Object::Name;
2              
3 1     1   32593 use 5.014;
  1         3  
4              
5 1     1   5 use strict;
  1         1  
  1         19  
6 1     1   4 use warnings;
  1         1  
  1         20  
7 1     1   4 use routines;
  1         3  
  1         6  
8              
9             our $VERSION = '2.03'; # VERSION
10              
11             # BUILD
12              
13             my $sep = qr/'|__|::|\\|\//;
14              
15             # METHODS
16              
17 1     1 1 5 method dist() {
  1         3  
18              
19 1         4 return $self->label =~ s/_/-/gr;
20             }
21              
22 2     2 1 7 method file() {
  2         3  
23 2 50       5 return $$self if $self->lookslike_a_file;
24              
25 2         6 my $string = $self->package;
26              
27             return join '__', map {
28 2         10 join '_', map {lc} map {split /_/} grep {length}
  4         14  
  6         25  
  6         10  
  12         16  
29             split /([A-Z]{1}[^A-Z]*)/
30             } split /$sep/, $string;
31             }
32              
33 1     1 1 5 method format($method, $format) {
  1         3  
  1         2  
34 1         2 my $string = $self->$method;
35              
36 1   50     13 return sprintf($format || '%s', $string);
37             }
38              
39 2     2 1 7 method label() {
  2         2  
40 2 50       9 return $$self if $self->lookslike_a_label;
41              
42 2         9 return join '_', split /$sep/, $self->package;
43             }
44              
45 3     3 1 8 method lookslike_a_file() {
  3         4  
46 3         7 my $string = $$self;
47              
48 3         18 return $string =~ /^[a-z](?:\w*[a-z])?$/;
49             }
50              
51 3     3 1 6 method lookslike_a_label() {
  3         6  
52 3         5 my $string = $$self;
53              
54 3         25 return $string =~ /^[A-Z](?:\w*[a-zA-Z0-9])?$/;
55             }
56              
57 6     6 1 21 method lookslike_a_package() {
  6         19  
58 6         14 my $string = $$self;
59              
60 6         44 return $string =~ /^[A-Z](?:(?:\w|::)*[a-zA-Z0-9])?$/;
61             }
62              
63 2     2 1 7 method lookslike_a_path() {
  2         4  
64 2         4 my $string = $$self;
65              
66 2         30 return $string =~ /^[A-Z](?:(?:\w|\\|\/|[\:\.]{1}[a-zA-Z0-9])*[a-zA-Z0-9])?$/;
67             }
68              
69 7     7 1 14 method lookslike_a_pragma() {
  7         10  
70 7         11 my $string = $$self;
71              
72 7         31 return $string =~ /^\[\w+\]$/;
73             }
74              
75 14 100   14 1 119596 method new($class: $name = '') {
  14         48  
  14         16  
76              
77 14         235 return bless \$name, $class;
78             }
79              
80 5     5 1 78 method package() {
  5         10  
81 5 50       14 return $$self if $self->lookslike_a_package;
82              
83 5 50       14 return substr($$self, 1, -1) if $self->lookslike_a_pragma;
84              
85 5         8 my $string = $$self;
86              
87 5 50       36 if ($string !~ $sep) {
88 0         0 return join '', map {ucfirst} split /[^a-zA-Z0-9]/, $string;
  0         0  
89             } else {
90             return join '::', map {
91 5         30 join '', map {ucfirst} split /[^a-zA-Z0-9]/
  10         24  
  10         78  
92             } split /$sep/, $string;
93             }
94             }
95              
96 1     1 1 5 method path() {
  1         2  
97 1 50       4 return $$self if $self->lookslike_a_path;
98              
99 0           return join '/', split /$sep/, $self->package;
100             }
101              
102             1;
103              
104             =encoding utf8
105              
106             =head1 NAME
107              
108             Data::Object::Name
109              
110             =cut
111              
112             =head1 ABSTRACT
113              
114             Name Class for Perl 5
115              
116             =cut
117              
118             =head1 SYNOPSIS
119              
120             use Data::Object::Name;
121              
122             my $name = Data::Object::Name->new('FooBar/Baz');
123              
124             =cut
125              
126             =head1 DESCRIPTION
127              
128             This package provides methods for converting "name" strings.
129              
130             =cut
131              
132             =head1 METHODS
133              
134             This package implements the following methods:
135              
136             =cut
137              
138             =head2 dist
139              
140             dist() : Str
141              
142             The dist method returns a package distribution representation of the name.
143              
144             =over 4
145              
146             =item dist example #1
147              
148             # given: synopsis
149              
150             my $dist = $name->dist; # FooBar-Baz
151              
152             =back
153              
154             =cut
155              
156             =head2 file
157              
158             file() : Str
159              
160             The file method returns a file representation of the name.
161              
162             =over 4
163              
164             =item file example #1
165              
166             # given: synopsis
167              
168             my $file = $name->file; # foo_bar__baz
169              
170             =back
171              
172             =cut
173              
174             =head2 format
175              
176             format(Str $method, Str $format) : Str
177              
178             The format method calls the specified method passing the result to the core
179             L</sprintf> function with itself as an argument.
180              
181             =over 4
182              
183             =item format example #1
184              
185             # given: synopsis
186              
187             my $file = $name->format('file', '%s.t'); # foo_bar__baz.t
188              
189             =back
190              
191             =cut
192              
193             =head2 label
194              
195             label() : Str
196              
197             The label method returns a label (or constant) representation of the name.
198              
199             =over 4
200              
201             =item label example #1
202              
203             # given: synopsis
204              
205             my $label = $name->label; # FooBar_Baz
206              
207             =back
208              
209             =cut
210              
211             =head2 lookslike_a_file
212              
213             lookslike_a_file() : Bool
214              
215             The lookslike_a_file method returns truthy if its state resembles a filename.
216              
217             =over 4
218              
219             =item lookslike_a_file example #1
220              
221             # given: synopsis
222              
223             my $is_file = $name->lookslike_a_file; # falsy
224              
225             =back
226              
227             =cut
228              
229             =head2 lookslike_a_label
230              
231             lookslike_a_label() : Bool
232              
233             The lookslike_a_label method returns truthy if its state resembles a label (or
234             constant).
235              
236             =over 4
237              
238             =item lookslike_a_label example #1
239              
240             # given: synopsis
241              
242             my $is_label = $name->lookslike_a_label; # falsy
243              
244             =back
245              
246             =cut
247              
248             =head2 lookslike_a_package
249              
250             lookslike_a_package() : Bool
251              
252             The lookslike_a_package method returns truthy if its state resembles a package
253             name.
254              
255             =over 4
256              
257             =item lookslike_a_package example #1
258              
259             # given: synopsis
260              
261             my $is_package = $name->lookslike_a_package; # falsy
262              
263             =back
264              
265             =cut
266              
267             =head2 lookslike_a_path
268              
269             lookslike_a_path() : Bool
270              
271             The lookslike_a_path method returns truthy if its state resembles a file path.
272              
273             =over 4
274              
275             =item lookslike_a_path example #1
276              
277             # given: synopsis
278              
279             my $is_path = $name->lookslike_a_path; # truthy
280              
281             =back
282              
283             =cut
284              
285             =head2 lookslike_a_pragma
286              
287             lookslike_a_pragma() : Bool
288              
289             The lookslike_a_pragma method returns truthy if its state resembles a pragma.
290              
291             =over 4
292              
293             =item lookslike_a_pragma example #1
294              
295             # given: synopsis
296              
297             my $is_pragma = $name->lookslike_a_pragma; # falsy
298              
299             =back
300              
301             =over 4
302              
303             =item lookslike_a_pragma example #2
304              
305             use Data::Object::Name;
306              
307             my $name = Data::Object::Name->new('[strict]');
308              
309             my $is_pragma = $name->lookslike_a_pragma; # truthy
310              
311             =back
312              
313             =cut
314              
315             =head2 new
316              
317             new(Str $arg) : Object
318              
319             The new method instantiates the class and returns an object.
320              
321             =over 4
322              
323             =item new example #1
324              
325             use Data::Object::Name;
326              
327             my $name = Data::Object::Name->new;
328              
329             =back
330              
331             =over 4
332              
333             =item new example #2
334              
335             use Data::Object::Name;
336              
337             my $name = Data::Object::Name->new('FooBar');
338              
339             =back
340              
341             =cut
342              
343             =head2 package
344              
345             package() : Str
346              
347             The package method returns a package name representation of the name given.
348              
349             =over 4
350              
351             =item package example #1
352              
353             # given: synopsis
354              
355             my $package = $name->package; # FooBar::Baz
356              
357             =back
358              
359             =cut
360              
361             =head2 path
362              
363             path() : Str
364              
365             The path method returns a path representation of the name.
366              
367             =over 4
368              
369             =item path example #1
370              
371             # given: synopsis
372              
373             my $path = $name->path; # FooBar/Baz
374              
375             =back
376              
377             =cut
378              
379             =head1 AUTHOR
380              
381             Al Newkirk, C<awncorp@cpan.org>
382              
383             =head1 LICENSE
384              
385             Copyright (C) 2011-2019, Al Newkirk, et al.
386              
387             This is free software; you can redistribute it and/or modify it under the terms
388             of the The Apache License, Version 2.0, as elucidated in the L<"license
389             file"|https://github.com/iamalnewkirk/data-object-name/blob/master/LICENSE>.
390              
391             =head1 PROJECT
392              
393             L<Wiki|https://github.com/iamalnewkirk/data-object-name/wiki>
394              
395             L<Project|https://github.com/iamalnewkirk/data-object-name>
396              
397             L<Initiatives|https://github.com/iamalnewkirk/data-object-name/projects>
398              
399             L<Milestones|https://github.com/iamalnewkirk/data-object-name/milestones>
400              
401             L<Contributing|https://github.com/iamalnewkirk/data-object-name/blob/master/CONTRIBUTE.md>
402              
403             L<Issues|https://github.com/iamalnewkirk/data-object-name/issues>
404              
405             =cut