File Coverage

blib/lib/Venus/Name.pm
Criterion Covered Total %
statement 68 72 94.4
branch 10 12 83.3
condition 1 2 50.0
subroutine 22 23 95.6
pod 14 15 93.3
total 115 124 92.7


line stmt bran cond sub pod time code
1             package Venus::Name;
2              
3 11     11   215 use 5.018;
  11         44  
4              
5 11     11   78 use strict;
  11         26  
  11         267  
6 11     11   52 use warnings;
  11         34  
  11         360  
7              
8 11     11   76 use Venus::Class 'base', 'with';
  11         30  
  11         82  
9              
10             base 'Venus::Kind::Utility';
11              
12             with 'Venus::Role::Valuable';
13             with 'Venus::Role::Buildable';
14             with 'Venus::Role::Accessible';
15             with 'Venus::Role::Explainable';
16              
17             use overload (
18             '""' => 'explain',
19 3     3   14 'eq' => sub{$_[0]->value eq "$_[1]"},
20 2     2   10 'ne' => sub{$_[0]->value ne "$_[1]"},
21 1     1   4 'qr' => sub{qr/@{[quotemeta($_[0]->value)]}/},
  1         5  
22 11         210 '~~' => 'explain',
23             fallback => 1,
24 11     11   1359 );
  11         1197  
25              
26             my $sep = qr/'|__|::|\\|\//;
27              
28             # BUILDERS
29              
30             sub build_arg {
31 523     523 0 1224 my ($self, $data) = @_;
32              
33             return {
34 523         1942 value => $data,
35             };
36             }
37              
38             # METHODS
39              
40             sub assertion {
41 0     0 1 0 my ($self) = @_;
42              
43 0         0 my $assert = $self->SUPER::assertion;
44              
45 0         0 $assert->clear->expression('string');
46              
47 0         0 return $assert;
48             }
49              
50             sub default {
51 1     1 1 6 return 'Venus';
52             }
53              
54             sub dist {
55 1     1 1 3 my ($self) = @_;
56              
57 1         5 return $self->label =~ s/_/-/gr;
58             }
59              
60             sub explain {
61 9     9 1 145 my ($self) = @_;
62              
63 9         32 return $self->get;
64             }
65              
66             sub file {
67 2     2 1 8 my ($self) = @_;
68              
69 2 50       10 return $self->get if $self->lookslike_a_file;
70              
71 2         10 my $string = $self->package;
72              
73             return join '__', map {
74 2         11 join '_', map {lc} map {split /_/} grep {length}
  4         17  
  4         23  
  4         11  
  8         13  
75             split /([A-Z]{1}[^A-Z]*)/
76             } split /$sep/, $string;
77             }
78              
79             sub format {
80 491     491 1 1056 my ($self, $method, $format) = @_;
81              
82 491         789 local $_ = $self;
83              
84 491         1359 my $string = $self->$method;
85              
86 491   50     4156 return sprintf($format || '%s', $string);
87             }
88              
89             sub label {
90 103     103 1 211 my ($self) = @_;
91              
92 103 100       238 return $self->get if $self->lookslike_a_label;
93              
94 62         328 return join '_', split /$sep/, $self->package;
95             }
96              
97             sub lookslike_a_file {
98 3     3 1 9 my ($self) = @_;
99              
100 3         13 my $string = $self->get;
101              
102 3         31 return $string =~ /^[a-z](?:\w*[a-z])?$/;
103             }
104              
105             sub lookslike_a_label {
106 104     104 1 170 my ($self) = @_;
107              
108 104         208 my $string = $self->get;
109              
110 104         659 return $string =~ /^[A-Z](?:\w*[a-zA-Z0-9])?$/;
111             }
112              
113             sub lookslike_a_package {
114 1651     1651 1 2386 my ($self) = @_;
115              
116 1651         3111 my $string = $self->get;
117              
118 1651         11749 return $string =~ /^[A-Z](?:(?:\w|::)*[a-zA-Z0-9])?$/;
119             }
120              
121             sub lookslike_a_path {
122 559     559 1 913 my ($self) = @_;
123              
124 559         1292 my $string = $self->get;
125              
126 559         4251 return $string =~ /^[A-Z](?:(?:\w|\\|\/|[\:\.]{1}[a-zA-Z0-9])*[a-zA-Z0-9])?$/;
127             }
128              
129             sub lookslike_a_pragma {
130 758     758 1 1271 my ($self) = @_;
131              
132 758         1678 my $string = $self->get;
133              
134 758         3692 return $string =~ /^\[\w+\]$/;
135             }
136              
137             sub package {
138 1650     1650 1 2747 my ($self) = @_;
139              
140 1650 100       2967 return $self->get if $self->lookslike_a_package;
141              
142 258 50       795 return substr($self->get, 1, -1) if $self->lookslike_a_pragma;
143              
144 258         679 my $string = $self->get;
145              
146 258 100       2357 if ($string !~ $sep) {
147 34         192 return join '', map {ucfirst} split /[^a-zA-Z0-9]/, $string;
  47         245  
148             } else {
149             return join '::', map {
150 224         1404 join '', map {ucfirst} split /[^a-zA-Z0-9]/
  464         1244  
  467         2273  
151             } split /$sep/, $string;
152             }
153             }
154              
155             sub path {
156 558     558 1 900 my ($self) = @_;
157              
158 558 100       1228 return $self->get if $self->lookslike_a_path;
159              
160 295         1301 return join '/', split /$sep/, $self->package;
161             }
162              
163             1;
164              
165              
166              
167             =head1 NAME
168              
169             Venus::Name - Name Class
170              
171             =cut
172              
173             =head1 ABSTRACT
174              
175             Name Class for Perl 5
176              
177             =cut
178              
179             =head1 SYNOPSIS
180              
181             package main;
182              
183             use Venus::Name;
184              
185             my $name = Venus::Name->new('Foo/Bar');
186              
187             # $name->package;
188              
189             =cut
190              
191             =head1 DESCRIPTION
192              
193             This package provides methods for parsing and formatting package namespace
194             strings.
195              
196             =cut
197              
198             =head1 INHERITS
199              
200             This package inherits behaviors from:
201              
202             L
203              
204             =cut
205              
206             =head1 INTEGRATES
207              
208             This package integrates behaviors from:
209              
210             L
211              
212             L
213              
214             L
215              
216             L
217              
218             =cut
219              
220             =head1 METHODS
221              
222             This package provides the following methods:
223              
224             =cut
225              
226             =head2 default
227              
228             default() (Str)
229              
230             The default method returns the default value, i.e. C<'Venus'>.
231              
232             I>
233              
234             =over 4
235              
236             =item default example 1
237              
238             # given: synopsis;
239              
240             my $default = $name->default;
241              
242             # "Venus"
243              
244             =back
245              
246             =cut
247              
248             =head2 dist
249              
250             dist() (Str)
251              
252             The dist method returns a package distribution representation of the name.
253              
254             I>
255              
256             =over 4
257              
258             =item dist example 1
259              
260             # given: synopsis;
261              
262             my $dist = $name->dist;
263              
264             # "Foo-Bar"
265              
266             =back
267              
268             =cut
269              
270             =head2 explain
271              
272             explain() (Str)
273              
274             The explain method returns the package name and is used in stringification
275             operations.
276              
277             I>
278              
279             =over 4
280              
281             =item explain example 1
282              
283             # given: synopsis;
284              
285             my $explain = $name->explain;
286              
287             # "Foo/Bar"
288              
289             =back
290              
291             =cut
292              
293             =head2 file
294              
295             file() (Str)
296              
297             The file method returns a file representation of the name.
298              
299             I>
300              
301             =over 4
302              
303             =item file example 1
304              
305             # given: synopsis;
306              
307             my $file = $name->file;
308              
309             # "foo__bar"
310              
311             =back
312              
313             =cut
314              
315             =head2 format
316              
317             format(Str $method, Str $format) (Str)
318              
319             The format method calls the specified method passing the result to the core
320             L function with itself as an argument. This method supports
321             dispatching, i.e. providing a method name and arguments whose return value will
322             be acted on by this method.
323              
324             I>
325              
326             =over 4
327              
328             =item format example 1
329              
330             # given: synopsis;
331              
332             my $format = $name->format('file', '%s.t');
333              
334             # "foo__bar.t"
335              
336             =back
337              
338             =cut
339              
340             =head2 label
341              
342             label() (Str)
343              
344             The label method returns a label (or constant) representation of the name.
345              
346             I>
347              
348             =over 4
349              
350             =item label example 1
351              
352             # given: synopsis;
353              
354             my $label = $name->label;
355              
356             # "Foo_Bar"
357              
358             =back
359              
360             =cut
361              
362             =head2 lookslike_a_file
363              
364             lookslike_a_file() (Str)
365              
366             The lookslike_a_file method returns truthy if its state resembles a filename.
367              
368             I>
369              
370             =over 4
371              
372             =item lookslike_a_file example 1
373              
374             # given: synopsis;
375              
376             my $lookslike_a_file = $name->lookslike_a_file;
377              
378             # ""
379              
380             =back
381              
382             =cut
383              
384             =head2 lookslike_a_label
385              
386             lookslike_a_label() (Str)
387              
388             The lookslike_a_label method returns truthy if its state resembles a label (or
389             constant).
390              
391             I>
392              
393             =over 4
394              
395             =item lookslike_a_label example 1
396              
397             # given: synopsis;
398              
399             my $lookslike_a_label = $name->lookslike_a_label;
400              
401             # ""
402              
403             =back
404              
405             =cut
406              
407             =head2 lookslike_a_package
408              
409             lookslike_a_package() (Str)
410              
411             The lookslike_a_package method returns truthy if its state resembles a package
412             name.
413              
414             I>
415              
416             =over 4
417              
418             =item lookslike_a_package example 1
419              
420             # given: synopsis;
421              
422             my $lookslike_a_package = $name->lookslike_a_package;
423              
424             # ""
425              
426             =back
427              
428             =cut
429              
430             =head2 lookslike_a_path
431              
432             lookslike_a_path() (Str)
433              
434             The lookslike_a_path method returns truthy if its state resembles a file path.
435              
436             I>
437              
438             =over 4
439              
440             =item lookslike_a_path example 1
441              
442             # given: synopsis;
443              
444             my $lookslike_a_path = $name->lookslike_a_path;
445              
446             # 1
447              
448             =back
449              
450             =cut
451              
452             =head2 lookslike_a_pragma
453              
454             lookslike_a_pragma() (Str)
455              
456             The lookslike_a_pragma method returns truthy if its state resembles a pragma.
457              
458             I>
459              
460             =over 4
461              
462             =item lookslike_a_pragma example 1
463              
464             # given: synopsis;
465              
466             my $lookslike_a_pragma = $name->lookslike_a_pragma;
467              
468             # ""
469              
470             =back
471              
472             =cut
473              
474             =head2 package
475              
476             package() (Str)
477              
478             The package method returns a package name representation of the name given.
479              
480             I>
481              
482             =over 4
483              
484             =item package example 1
485              
486             # given: synopsis;
487              
488             my $package = $name->package;
489              
490             # "Foo::Bar"
491              
492             =back
493              
494             =cut
495              
496             =head2 path
497              
498             path() (Str)
499              
500             The path method returns a path representation of the name.
501              
502             I>
503              
504             =over 4
505              
506             =item path example 1
507              
508             # given: synopsis;
509              
510             my $path = $name->path;
511              
512             # "Foo/Bar"
513              
514             =back
515              
516             =cut
517              
518             =head1 OPERATORS
519              
520             This package overloads the following operators:
521              
522             =cut
523              
524             =over 4
525              
526             =item operation: C<(.)>
527              
528             This package overloads the C<.> operator.
529              
530             B
531              
532             # given: synopsis;
533              
534             my $package = $name . 'Baz';
535              
536             # "Foo::BarBaz"
537              
538             =back
539              
540             =over 4
541              
542             =item operation: C<(eq)>
543              
544             This package overloads the C operator.
545              
546             B
547              
548             # given: synopsis;
549              
550             $name eq 'Foo/Bar';
551              
552             # 1
553              
554             B
555              
556             package main;
557              
558             use Venus::Name;
559              
560             my $name1 = Venus::Name->new('Foo\Bar');
561             my $name2 = Venus::Name->new('Foo\Bar');
562              
563             $name1 eq $name2;
564              
565             # 1
566              
567             =back
568              
569             =over 4
570              
571             =item operation: C<(ne)>
572              
573             This package overloads the C operator.
574              
575             B
576              
577             # given: synopsis;
578              
579             $name ne 'Foo\Bar';
580              
581             # 1
582              
583             B
584              
585             package main;
586              
587             use Venus::Name;
588              
589             my $name1 = Venus::Name->new('FooBar');
590             my $name2 = Venus::Name->new('Foo_Bar');
591              
592             $name1 ne $name2;
593              
594             # 1
595              
596             =back
597              
598             =over 4
599              
600             =item operation: C<(qr)>
601              
602             This package overloads the C operator.
603              
604             B
605              
606             # given: synopsis;
607              
608             "Foo/Bar" =~ qr/$name/;
609              
610             # 1
611              
612             =back
613              
614             =over 4
615              
616             =item operation: C<("")>
617              
618             This package overloads the C<""> operator.
619              
620             B
621              
622             # given: synopsis;
623              
624             my $result = "$name";
625              
626             # "Foo/Bar"
627              
628             B
629              
630             # given: synopsis;
631              
632             my $result = "$name, $name";
633              
634             # "Foo/Bar, Foo/Bar"
635              
636             =back
637              
638             =over 4
639              
640             =item operation: C<(~~)>
641              
642             This package overloads the C<~~> operator.
643              
644             B
645              
646             # given: synopsis;
647              
648             my $result = $name ~~ 'Foo/Bar';
649              
650             # 1
651              
652             =back
653              
654             =head1 AUTHORS
655              
656             Awncorp, C
657              
658             =cut
659              
660             =head1 LICENSE
661              
662             Copyright (C) 2000, Al Newkirk.
663              
664             This program is free software, you can redistribute it and/or modify it under
665             the terms of the Apache license version 2.0.
666              
667             =cut