File Coverage

blib/lib/Venus/Type.pm
Criterion Covered Total %
statement 396 399 99.2
branch 82 94 87.2
condition 26 33 78.7
subroutine 149 150 99.3
pod 8 134 5.9
total 661 810 81.6


line stmt bran cond sub pod time code
1             package Venus::Type;
2              
3 96     96   1746 use 5.018;
  96         355  
4              
5 96     96   532 use strict;
  96         207  
  96         2105  
6 96     96   456 use warnings;
  96         190  
  96         3072  
7              
8 96     96   581 use Venus::Class 'base', 'with';
  96         231  
  96         675  
9              
10             base 'Venus::Kind::Utility';
11              
12             with 'Venus::Role::Valuable';
13             with 'Venus::Role::Buildable';
14             with 'Venus::Role::Accessible';
15              
16 96     96   726 use Scalar::Util ();
  96         322  
  96         648938  
17              
18             # BUILDERS
19              
20             sub build_arg {
21 1308     1308 0 2940 my ($self, $data) = @_;
22              
23             return {
24 1308         4797 value => $data
25             };
26             }
27              
28             sub build_args {
29 3472     3472 0 7238 my ($self, $data) = @_;
30              
31 3472 100 66     16543 if (keys %$data == 1 && exists $data->{value}) {
    50          
32 3469         10654 return $data;
33             }
34             elsif (keys %$data) {
35             return {
36 3         18 value => $data,
37             }
38             }
39             else {
40             return {
41 0         0 value => $self->default
42             };
43             }
44             }
45              
46             sub build_nil {
47 31     31 0 127 my ($self, $data) = @_;
48              
49             return {
50 31         150 value => $data
51             };
52             }
53              
54             # METHODS
55              
56             sub cast {
57 114     114 0 407 my ($self, $kind, $callback, @args) = @_;
58              
59 114         372 my $code = $self->code;
60              
61 114 50       315 return undef if !$code;
62              
63 114   66     785 my $method = join '_', map lc, 'from', $code, 'to', $kind || $code;
64              
65 114         408 my $result = $self->$method($self->value);
66              
67 114         296 local $_ = $result;
68              
69 114 50       323 $result = Venus::Type->new($result->$callback(@args))->deduce if $callback;
70              
71 114         640 return $result;
72             }
73              
74             sub code {
75 1394     1394 1 2387 my ($self) = @_;
76              
77 1394         3480 return scalar $self->identify;
78             }
79              
80             sub coded {
81 1277     1277 1 2844 my ($self, $code) = @_;
82              
83 1277         2857 return uc($self->code) eq uc("$code");
84             }
85              
86             sub deduce {
87 1173     1173 1 2536 my ($self) = @_;
88              
89 1173         3109 my $data = $self->get;
90              
91 1173 100       3674 return $self->into_undef if not(defined($data));
92 1047 100       2957 return $self->deduce_blessed if scalar_is_blessed($data);
93 112         297 return $self->deduce_defined;
94             }
95              
96             sub deduce_boolean {
97 1     1 0 4 my ($self) = @_;
98              
99 1         5 my $data = $self->get;
100              
101 1         11 return $self->into_boolean;
102             }
103              
104             sub deduce_blessed {
105 935     935 0 1905 my ($self) = @_;
106              
107 935         2203 my $data = $self->get;
108              
109 935 100       7129 return $self->into_regexp if $data->isa('Regexp');
110 932         2637 return $data;
111             }
112              
113             sub deduce_deep {
114 6     6 1 21 my ($self) = @_;
115              
116 6         21 my $data = $self->deduce;
117              
118 6 100 66     28 if ($data and $data->isa('Venus::Hash')) {
119 4         24 for my $i (keys %{$data->get}) {
  4         15  
120 8         21 my $val = $data->get->{$i};
121 8 100       48 $data->get->{$i} = ref($val)
122             ? $self->class->new(value => $val)->deduce_deep
123             : $self->class->new(value => $val)->deduce;
124             }
125             }
126 6 100 66     20 if ($data and $data->isa('Venus::Array')) {
127 2         6 for (my $i = 0; $i < @{$data->get}; $i++) {
  10         25  
128 8         19 my $val = $data->get->[$i];
129 8 50       48 $data->get->[$i] = ref($val)
130             ? $self->class->new(value => $val)->deduce_deep
131             : $self->class->new(value => $val)->deduce;
132             }
133             }
134              
135 6         29 return $data;
136             }
137              
138             sub deduce_defined {
139 112     112 0 195 my ($self) = @_;
140              
141 112         250 my $data = $self->get;
142              
143 112 100       382 return $self->deduce_references if ref($data);
144 88 100       225 return $self->deduce_boolean if scalar_is_boolean($data);
145 87 100       237 return $self->deduce_floatlike if scalar_is_float($data);
146 81 100       204 return $self->deduce_numberlike if scalar_is_numeric($data);
147 15         71 return $self->deduce_stringlike;
148             }
149              
150             sub deduce_floatlike {
151 6     6 0 32 my ($self) = @_;
152              
153 6         22 my $data = $self->get;
154              
155 6         47 return $self->into_float;
156             }
157              
158             sub deduce_numberlike {
159 66     66 0 136 my ($self) = @_;
160              
161 66         189 my $data = $self->get;
162              
163 66         229 return $self->into_number;
164             }
165              
166             sub deduce_references {
167 24     24 0 52 my ($self) = @_;
168              
169 24         53 my $data = $self->get;
170              
171 24 100       111 return $self->into_array if ref($data) eq 'ARRAY';
172 14 50       69 return $self->into_code if ref($data) eq 'CODE';
173 14 100       64 return $self->into_hash if ref($data) eq 'HASH';
174 3         12 return $self->into_scalar; # glob, etc
175             }
176              
177             sub deduce_stringlike {
178 15     15 0 34 my ($self) = @_;
179              
180 15         44 my $data = $self->get;
181              
182 15         86 return $self->into_string;
183             }
184              
185             sub default {
186              
187 0     0 0 0 return undef;
188             }
189              
190             sub detract {
191 12     12 1 22 my ($self) = @_;
192              
193 12         26 my $data = $self->get;
194              
195 12 50       26 return $data if not(scalar_is_blessed($data));
196              
197 12 50       52 return $data->value if UNIVERSAL::isa($data, 'Venus::Kind');
198              
199 0         0 return $data;
200             }
201              
202             sub detract_deep {
203 8     8 1 15 my ($self) = @_;
204              
205 8         17 my $data = $self->detract;
206              
207 8 100 66     44 if ($data and ref($data) and ref($data) eq 'HASH') {
      100        
208 1         3 for my $i (keys %{$data}) {
  1         5  
209 2         4 my $val = $data->{$i};
210 2 50       6 $data->{$i} = scalar_is_blessed($val)
211             ? $self->class->new(value => $val)->detract_deep
212             : $self->class->new(value => $val)->detract;
213             }
214             }
215 8 100 66     43 if ($data and ref($data) and ref($data) eq 'ARRAY') {
      100        
216 1         24 for (my $i = 0; $i < @{$data}; $i++) {
  5         12  
217 4         9 my $val = $data->[$i];
218 4 50       10 $data->[$i] = scalar_is_blessed($val)
219             ? $self->class->new(value => $val)->detract_deep
220             : $self->class->new(value => $val)->detract;
221             }
222             }
223              
224 8         32 return $data;
225             }
226              
227             sub from_array_to_array {
228 1     1 0 4 my ($self, $data) = @_;
229              
230 1         6 return $self->into_array($data);
231             }
232              
233             sub from_array_to_boolean {
234 1     1 0 5 my ($self, $data) = @_;
235              
236 1         4 return $self->into_boolean(1);
237             }
238              
239             sub from_array_to_code {
240 1     1 0 6 my ($self, $data) = @_;
241              
242 1     1   29 return $self->into_code(sub{$data});
  1         17  
243             }
244              
245             sub from_array_to_float {
246 1     1 0 7 my ($self, $data) = @_;
247              
248 1         9 return $self->into_float(join('.', map int, !!$data, 0));
249             }
250              
251             sub from_array_to_hash {
252 1     1 0 14 my ($self, $data) = @_;
253              
254 1         7 return $self->into_hash({map +($_, $data->[$_]), 0..$#$data});
255             }
256              
257             sub from_array_to_number {
258 1     1 0 9 my ($self, $data) = @_;
259              
260 1         17 return $self->into_number(length($self->dump('value')));
261             }
262              
263             sub from_array_to_regexp {
264 1     1 0 7 my ($self, $data) = @_;
265              
266 1         19 return $self->into_regexp(qr{@{[quotemeta($self->dump('value'))]}});
  1         11  
267             }
268              
269             sub from_array_to_scalar {
270 1     1 0 4 my ($self, $data) = @_;
271              
272 1         6 return $self->into_scalar(\$data);
273             }
274              
275             sub from_array_to_string {
276 1     1 0 6 my ($self, $data) = @_;
277              
278 1         6 return $self->into_string($self->dump('value'));
279             }
280              
281             sub from_array_to_undef {
282 1     1 0 4 my ($self, $data) = @_;
283              
284 1         4 return $self->into_undef($data);
285             }
286              
287             sub from_boolean_to_array {
288 1     1 0 5 my ($self, $data) = @_;
289              
290 1         4 return $self->into_array([$data]);
291             }
292              
293             sub from_boolean_to_boolean {
294 1     1 0 5 my ($self, $data) = @_;
295              
296 1         4 return $self->into_boolean($data);
297             }
298              
299             sub from_boolean_to_code {
300 1     1 0 4 my ($self, $data) = @_;
301              
302 1     1   11 return $self->into_code(sub{$data});
  1         11  
303             }
304              
305             sub from_boolean_to_float {
306 1     1 0 13 my ($self, $data) = @_;
307              
308 1         8 return $self->into_float(join('.', map int, !!$data, 0));
309             }
310              
311             sub from_boolean_to_hash {
312 1     1 0 4 my ($self, $data) = @_;
313              
314 1         8 return $self->into_hash({$data, $data});
315             }
316              
317             sub from_boolean_to_number {
318 1     1 0 5 my ($self, $data) = @_;
319              
320 1         8 return $self->into_number(0+!!$data);
321             }
322              
323             sub from_boolean_to_regexp {
324 1     1 0 3 my ($self, $data) = @_;
325              
326 1         3 return $self->into_regexp(qr{@{[$self->dump('value')]}});
  1         12  
327             }
328              
329             sub from_boolean_to_scalar {
330 1     1 0 7 my ($self, $data) = @_;
331              
332 1         5 return $self->into_scalar(\$data);
333             }
334              
335             sub from_boolean_to_string {
336 1     1 0 4 my ($self, $data) = @_;
337              
338 1         4 return $self->into_string($self->dump('value'));
339             }
340              
341             sub from_boolean_to_undef {
342 1     1 0 5 my ($self, $data) = @_;
343              
344 1         6 return $self->into_undef($data);
345             }
346              
347             sub from_code_to_array {
348 1     1 0 3 my ($self, $data) = @_;
349              
350 1         6 return $self->into_array([$data]);
351             }
352              
353             sub from_code_to_boolean {
354 1     1 0 12 my ($self, $data) = @_;
355              
356 1         5 return $self->into_boolean(1);
357             }
358              
359             sub from_code_to_code {
360 1     1 0 5 my ($self, $data) = @_;
361              
362 1         7 return $self->into_code($data);
363             }
364              
365             sub from_code_to_float {
366 1     1 0 8 my ($self, $data) = @_;
367              
368 1         12 return $self->into_float(join('.', map int, !!$data, 0));
369             }
370              
371             sub from_code_to_hash {
372 1     1 0 6 my ($self, $data) = @_;
373              
374 1         8 return $self->into_hash({0, $data});
375             }
376              
377             sub from_code_to_number {
378 1     1 0 19 my ($self, $data) = @_;
379              
380 1         19 return $self->into_number(length($self->dump('value')));
381             }
382              
383             sub from_code_to_regexp {
384 1     1 0 6 my ($self, $data) = @_;
385              
386 1         2 return $self->into_regexp(qr{@{[quotemeta($self->dump('value'))]}});
  1         5  
387             }
388              
389             sub from_code_to_scalar {
390 1     1 0 12 my ($self, $data) = @_;
391              
392 1         7 return $self->into_scalar(\$data);
393             }
394              
395             sub from_code_to_string {
396 1     1 0 4 my ($self, $data) = @_;
397              
398 1         6 return $self->into_string($self->dump('value'));
399             }
400              
401             sub from_code_to_undef {
402 1     1 0 3 my ($self, $data) = @_;
403              
404 1         5 return $self->into_undef($data);
405             }
406              
407             sub from_float_to_array {
408 2     2 0 14 my ($self, $data) = @_;
409              
410 2         63 return $self->into_array([$data]);
411             }
412              
413             sub from_float_to_boolean {
414 1     1 0 8 my ($self, $data) = @_;
415              
416 1         6 return $self->into_boolean($data);
417             }
418              
419             sub from_float_to_code {
420 1     1 0 6 my ($self, $data) = @_;
421              
422 1     1   9 return $self->into_code(sub{$data});
  1         12  
423             }
424              
425             sub from_float_to_float {
426 2     2 0 7 my ($self, $data) = @_;
427              
428 2         9 return $self->into_float($data);
429             }
430              
431             sub from_float_to_hash {
432 2     2 0 18 my ($self, $data) = @_;
433              
434 2         21 return $self->into_hash({$data, $data});
435             }
436              
437             sub from_float_to_number {
438 1     1 0 4 my ($self, $data) = @_;
439              
440 1         7 return $self->into_number(0+$data);
441             }
442              
443             sub from_float_to_regexp {
444 1     1 0 8 my ($self, $data) = @_;
445              
446 1         3 return $self->into_regexp(qr{@{[quotemeta($self->dump('value'))]}});
  1         13  
447             }
448              
449             sub from_float_to_scalar {
450 2     2 0 10 my ($self, $data) = @_;
451              
452 2         9 return $self->into_scalar(\$data);
453             }
454              
455             sub from_float_to_string {
456 3     3 0 12 my ($self, $data) = @_;
457              
458 3         14 return $self->into_string($self->dump('value'));
459             }
460              
461             sub from_float_to_undef {
462 1     1 0 4 my ($self, $data) = @_;
463              
464 1         4 return $self->into_undef($data);
465             }
466              
467             sub from_hash_to_array {
468 1     1 0 2 my ($self, $data) = @_;
469              
470 1         5 return $self->into_array([$data]);
471             }
472              
473             sub from_hash_to_boolean {
474 1     1 0 5 my ($self, $data) = @_;
475              
476 1         4 return $self->into_boolean(1);
477             }
478              
479             sub from_hash_to_code {
480 1     1 0 5 my ($self, $data) = @_;
481              
482 1     1   9 return $self->into_code(sub{$data});
  1         12  
483             }
484              
485             sub from_hash_to_float {
486 1     1 0 9 my ($self, $data) = @_;
487              
488 1         12 return $self->into_float(join('.', map int, !!$data, 0));
489             }
490              
491             sub from_hash_to_hash {
492 1     1 0 234 my ($self, $data) = @_;
493              
494 1         166 return $self->into_hash($data);
495             }
496              
497             sub from_hash_to_number {
498 1     1 0 4 my ($self, $data) = @_;
499              
500 1         15 return $self->into_number(length($self->dump('value')));
501             }
502              
503             sub from_hash_to_regexp {
504 1     1 0 3 my ($self, $data) = @_;
505              
506 1         2 return $self->into_regexp(qr{@{[quotemeta($self->dump('value'))]}});
  1         4  
507             }
508              
509             sub from_hash_to_scalar {
510 1     1 0 10 my ($self, $data) = @_;
511              
512 1         5 return $self->into_scalar(\$data);
513             }
514              
515             sub from_hash_to_string {
516 1     1 0 7 my ($self, $data) = @_;
517              
518 1         7 return $self->into_string($self->dump('value'));
519             }
520              
521             sub from_hash_to_undef {
522 1     1 0 6 my ($self, $data) = @_;
523              
524 1         7 return $self->into_undef($data);
525             }
526              
527             sub from_number_to_array {
528 1     1 0 6 my ($self, $data) = @_;
529              
530 1         5 return $self->into_array([$data]);
531             }
532              
533             sub from_number_to_boolean {
534 1     1 0 8 my ($self, $data) = @_;
535              
536 1         6 return $self->into_boolean(!!$data);
537             }
538              
539             sub from_number_to_code {
540 1     1 0 10 my ($self, $data) = @_;
541              
542 1     1   10 return $self->into_code(sub{$data});
  1         5  
543             }
544              
545             sub from_number_to_float {
546 1     1 0 7 my ($self, $data) = @_;
547              
548 1         15 return $self->into_float(join('.', map int, (split(/\./, "${data}.0"))[0,1]));
549             }
550              
551             sub from_number_to_hash {
552 1     1 0 5 my ($self, $data) = @_;
553              
554 1         8 return $self->into_hash({$data, $data});
555             }
556              
557             sub from_number_to_number {
558 1     1 0 5 my ($self, $data) = @_;
559              
560 1         5 return $self->into_number($data);
561             }
562              
563             sub from_number_to_regexp {
564 1     1 0 5 my ($self, $data) = @_;
565              
566 1         4 return $self->into_regexp(qr{@{[quotemeta($self->dump('value'))]}});
  1         17  
567             }
568              
569             sub from_number_to_scalar {
570 2     2 0 12 my ($self, $data) = @_;
571              
572 2         9 return $self->into_scalar(\$data);
573             }
574              
575             sub from_number_to_string {
576 3     3 0 23 my ($self, $data) = @_;
577              
578 3         16 return $self->into_string($self->dump('value'));
579             }
580              
581             sub from_number_to_undef {
582 1     1 0 7 my ($self, $data) = @_;
583              
584 1         5 return $self->into_undef($data);
585             }
586              
587             sub from_regexp_to_array {
588 1     1 0 5 my ($self, $data) = @_;
589              
590 1         8 return $self->into_array([$data]);
591             }
592              
593             sub from_regexp_to_boolean {
594 1     1 0 6 my ($self, $data) = @_;
595              
596 1         4 return $self->into_boolean($data);
597             }
598              
599             sub from_regexp_to_code {
600 1     1 0 4 my ($self, $data) = @_;
601              
602 1     1   8 return $self->into_code(sub{$data});
  1         9  
603             }
604              
605             sub from_regexp_to_float {
606 1     1 0 4 my ($self, $data) = @_;
607              
608 1         8 return $self->into_float(join('.', map int, !!$data, 0));
609             }
610              
611             sub from_regexp_to_hash {
612 1     1 0 5 my ($self, $data) = @_;
613              
614 1         7 return $self->into_hash({0, $data});
615             }
616              
617             sub from_regexp_to_number {
618 1     1 0 5 my ($self, $data) = @_;
619              
620 1         15 return $self->into_number(length($self->dump('value')));
621             }
622              
623             sub from_regexp_to_regexp {
624 1     1 0 4 my ($self, $data) = @_;
625              
626 1         5 return $self->into_regexp($data);
627             }
628              
629             sub from_regexp_to_scalar {
630 1     1 0 5 my ($self, $data) = @_;
631              
632 1         6 return $self->into_scalar(\$data);
633             }
634              
635             sub from_regexp_to_string {
636 1     1 0 4 my ($self, $data) = @_;
637              
638 1         10 return $self->into_string($self->dump('value'));
639             }
640              
641             sub from_regexp_to_undef {
642 1     1 0 5 my ($self, $data) = @_;
643              
644 1         5 return $self->into_undef($data);
645             }
646              
647             sub from_scalar_to_array {
648 1     1 0 3 my ($self, $data) = @_;
649              
650 1         8 return $self->into_array([$data]);
651             }
652              
653             sub from_scalar_to_boolean {
654 1     1 0 7 my ($self, $data) = @_;
655              
656 1         7 return $self->into_boolean(1);
657             }
658              
659             sub from_scalar_to_code {
660 1     1 0 4 my ($self, $data) = @_;
661              
662 1     1   11 return $self->into_code(sub{$data});
  1         7  
663             }
664              
665             sub from_scalar_to_float {
666 1     1 0 4 my ($self, $data) = @_;
667              
668 1         11 return $self->into_float(join('.', map int, !!$data, 0));
669             }
670              
671             sub from_scalar_to_hash {
672 1     1 0 7 my ($self, $data) = @_;
673              
674 1         10 return $self->into_hash({0, $data});
675             }
676              
677             sub from_scalar_to_number {
678 1     1 0 3 my ($self, $data) = @_;
679              
680 1         26 return $self->into_number(length($self->dump('value')));
681             }
682              
683             sub from_scalar_to_regexp {
684 1     1 0 10 my ($self, $data) = @_;
685              
686 1         2 return $self->into_regexp(qr{@{[quotemeta($self->dump('value'))]}});
  1         4  
687             }
688              
689             sub from_scalar_to_scalar {
690 1     1 0 7 my ($self, $data) = @_;
691              
692 1         4 return $self->into_scalar($data);
693             }
694              
695             sub from_scalar_to_string {
696 1     1 0 4 my ($self, $data) = @_;
697              
698 1         6 return $self->into_string($self->dump('value'));
699             }
700              
701             sub from_scalar_to_undef {
702 1     1 0 6 my ($self, $data) = @_;
703              
704 1         6 return $self->into_undef($data);
705             }
706              
707             sub from_string_to_array {
708 1     1 0 4 my ($self, $data) = @_;
709              
710 1         8 return $self->into_array([$data]);
711             }
712              
713             sub from_string_to_boolean {
714 1     1 0 4 my ($self, $data) = @_;
715              
716 1         5 return $self->into_boolean(!!$data);
717             }
718              
719             sub from_string_to_code {
720 1     1 0 4 my ($self, $data) = @_;
721              
722 1     1   9 return $self->into_code(sub{$data});
  1         7  
723             }
724              
725             sub from_string_to_float {
726 1     1 0 5 my ($self, $data) = @_;
727              
728 1         5 require Scalar::Util;
729              
730 1 50       10 return $self->into_float(join('.',
731             Scalar::Util::looks_like_number($data) ? (split(/\./, "$data.0"))[0,1] : (0,0))
732             );
733             }
734              
735             sub from_string_to_hash {
736 1     1 0 5 my ($self, $data) = @_;
737              
738 1         8 return $self->into_hash({$data, $data});
739             }
740              
741             sub from_string_to_number {
742 1     1 0 4 my ($self, $data) = @_;
743              
744 1         5 require Scalar::Util;
745              
746 1 50       11 return $self->into_number(Scalar::Util::looks_like_number($data) ? 0+$data : 0);
747             }
748              
749             sub from_string_to_regexp {
750 1     1 0 4 my ($self, $data) = @_;
751              
752 1         3 return $self->into_regexp(qr{@{[$self->dump('value')]}});
  1         15  
753             }
754              
755             sub from_string_to_scalar {
756 2     2 0 9 my ($self, $data) = @_;
757              
758 2         11 return $self->into_scalar(\$data);
759             }
760              
761             sub from_string_to_string {
762 4     4 0 13 my ($self, $data) = @_;
763              
764 4         34 return $self->into_string($self->dump('value'));
765             }
766              
767             sub from_string_to_undef {
768 1     1 0 4 my ($self, $data) = @_;
769              
770 1         4 return $self->into_undef($data);
771             }
772              
773             sub from_undef_to_array {
774 1     1 0 4 my ($self, $data) = @_;
775              
776 1         8 return $self->into_array([$data]);
777             }
778              
779             sub from_undef_to_boolean {
780 1     1 0 4 my ($self, $data) = @_;
781              
782 1         5 return $self->into_boolean(0);
783             }
784              
785             sub from_undef_to_code {
786 1     1 0 5 my ($self, $data) = @_;
787              
788 1     1   10 return $self->into_code(sub{$data});
  1         7  
789             }
790              
791             sub from_undef_to_float {
792 1     1 0 4 my ($self, $data) = @_;
793              
794 1         5 return $self->into_float('0.0');
795             }
796              
797             sub from_undef_to_hash {
798 1     1 0 3 my ($self, $data) = @_;
799              
800 1         4 return $self->into_hash({});
801             }
802              
803             sub from_undef_to_number {
804 1     1 0 5 my ($self, $data) = @_;
805              
806 1         12 return $self->into_number(0);
807             }
808              
809             sub from_undef_to_regexp {
810 1     1 0 10 my ($self, $data) = @_;
811              
812 1         9 return $self->into_regexp(qr//);
813             }
814              
815             sub from_undef_to_scalar {
816 1     1 0 4 my ($self, $data) = @_;
817              
818 1         6 return $self->into_scalar(\'');
819             }
820              
821             sub from_undef_to_string {
822 1     1 0 5 my ($self, $data) = @_;
823              
824 1         5 return $self->into_string('');
825             }
826              
827             sub from_undef_to_undef {
828 2     2 0 9 my ($self, $data) = @_;
829              
830 2         11 return $self->into_undef($data);
831             }
832              
833             sub identify {
834 2284     2284 1 3891 my ($self) = @_;
835              
836 2284         5626 my $data = $self->get;
837              
838 2284         5795 my $defined = true;
839 2284         5742 my $blessed = false;
840              
841 2284         3628 my $type_name;
842              
843 2284 100       7039 if (not(defined($data))) {
    100          
    100          
    100          
    100          
    100          
844 70         150 $type_name = 'UNDEF';
845 70         160 $defined = false;
846             }
847             elsif (scalar_is_blessed($data)) {
848 1119 100       5322 $type_name = $data->isa('Regexp') ? 'REGEXP' : 'OBJECT';
849 1119         2537 $blessed = true;
850             }
851             elsif (ref($data)) {
852 196 100       896 if (ref($data) eq 'ARRAY') {
    100          
    100          
853 75         142 $type_name = 'ARRAY';
854             }
855             elsif (ref($data) eq 'CODE') {
856 30         63 $type_name = 'CODE';
857             }
858             elsif (ref($data) eq 'HASH') {
859 75         164 $type_name = 'HASH';
860             }
861             else {
862 16         37 $type_name = 'SCALAR';
863             }
864             }
865             elsif (scalar_is_boolean($data)) {
866 22         54 $type_name = 'BOOLEAN';
867             }
868             elsif (scalar_is_float($data)) {
869 107         292 $type_name = 'FLOAT';
870             }
871             elsif (scalar_is_numeric($data)) {
872 215         436 $type_name = 'NUMBER';
873             }
874             else {
875 555         944 $type_name = 'STRING';
876             }
877              
878 2284 100       11641 return wantarray ? ($defined, $blessed, $type_name) : $type_name;
879             }
880              
881             sub into_array {
882 21     21 0 66 my ($self, $data) = @_;
883              
884 21 100       75 $data = [@{$self->get}] if $#_ <= 0;
  10         27  
885              
886 21         13475 require Venus::Array;
887              
888 21         174 return Venus::Array->new($data);
889             }
890              
891             sub into_boolean {
892 11     11 0 45 my ($self, $data) = @_;
893              
894 11 100       62 $data = $self->get if $#_ <= 0;
895              
896 11         10326 require Venus::Boolean;
897              
898 11         96 return Venus::Boolean->new($data);
899             }
900              
901             sub into_code {
902 10     10 0 43 my ($self, $data) = @_;
903              
904 10 50       54 $data = $self->get if $#_ <= 0;
905              
906 10         9633 require Venus::Code;
907              
908 10         111 return Venus::Code->new($data);
909             }
910              
911             sub into_float {
912 17     17 0 81 my ($self, $data) = @_;
913              
914 17 100       84 $data = $self->get if $#_ <= 0;
915              
916 17         11560 require Venus::Float;
917              
918 17         213 return Venus::Float->new($data);
919             }
920              
921             sub into_hash {
922 22     22 0 76 my ($self, $data) = @_;
923              
924 22 100       101 $data = {%{$self->get}} if $#_ <= 0;
  11         28  
925              
926 22         13011 require Venus::Hash;
927              
928 22         193 return Venus::Hash->new($data);
929             }
930              
931             sub into_number {
932 76     76 0 185 my ($self, $data) = @_;
933              
934 76 100       258 $data = $self->get if $#_ <= 0;
935              
936 76         6379 require Venus::Number;
937              
938 76         432 return Venus::Number->new($data);
939             }
940              
941             sub into_regexp {
942 13     13 0 61 my ($self, $data) = @_;
943              
944 13 100       78 $data = $self->get if $#_ <= 0;
945              
946 13         11369 require Venus::Regexp;
947              
948 13         339 return Venus::Regexp->new($data);
949             }
950              
951             sub into_scalar {
952 16     16 0 80 my ($self, $data) = @_;
953              
954 16 100       94 $data = $self->get if $#_ <= 0;
955              
956 16         10282 require Venus::Scalar;
957              
958 16         196 return Venus::Scalar->new($data);
959             }
960              
961             sub into_string {
962 32     32 0 111 my ($self, $data) = @_;
963              
964 32 100       137 $data = $self->get if $#_ <= 0;
965              
966 32         13502 require Venus::String;
967              
968 32         598 return Venus::String->new($data);
969             }
970              
971             sub into_undef {
972 137     137 0 374 my ($self, $data) = @_;
973              
974 137 100       564 $data = $self->get if $#_ <= 0;
975              
976 137         10130 require Venus::Undef;
977              
978 137         889 return Venus::Undef->new($data);
979             }
980              
981             sub package {
982 2     2 1 7 my ($self) = @_;
983              
984 2         5 my $data = $self->deduce;
985              
986 2         8 return ref($data);
987             }
988              
989             sub scalar_is_blessed {
990 3279     3279 0 5935 my ($value) = @_;
991              
992 3279         15472 return Scalar::Util::blessed($value);
993             }
994              
995             sub scalar_is_boolean {
996 987     987 0 1908 my ($value) = @_;
997              
998 987   66     4750 return Scalar::Util::isdual($value) && (
999             ("$value" eq "" && ($value + 0) == 0) || # support !!0
1000             ("$value" == "1" && ($value + 0) == 1) ||
1001             ("$value" == "0" && ($value + 0) == 0)
1002             );
1003             }
1004              
1005             sub scalar_is_float {
1006 964     964 0 1840 my ($value) = @_;
1007              
1008 964   100     4712 return Scalar::Util::looks_like_number($value) && length(do{
1009             $value =~ /^[+-]?([0-9]*)?\.[0-9]+$/;
1010             });
1011             }
1012              
1013             sub scalar_is_numeric {
1014 851     851 0 1634 my ($value) = @_;
1015              
1016 851   100     2804 return Scalar::Util::looks_like_number($value) && length(do{
1017 96     96   69290 no if $] >= 5.022, "feature", "bitwise";
  96         1470  
  96         926  
1018 96     96   20850 no warnings "numeric";
  96         232  
  96         13126  
1019             $value & ""
1020             });
1021             }
1022              
1023             1;
1024              
1025              
1026              
1027             =head1 NAME
1028              
1029             Venus::Type - Type Class
1030              
1031             =cut
1032              
1033             =head1 ABSTRACT
1034              
1035             Type Class for Perl 5
1036              
1037             =cut
1038              
1039             =head1 SYNOPSIS
1040              
1041             package main;
1042              
1043             use Venus::Type;
1044              
1045             my $type = Venus::Type->new([]);
1046              
1047             # $type->code;
1048              
1049             =cut
1050              
1051             =head1 DESCRIPTION
1052              
1053             This package provides methods for casting native data types to objects and the
1054             reverse.
1055              
1056             =cut
1057              
1058             =head1 INHERITS
1059              
1060             This package inherits behaviors from:
1061              
1062             L
1063              
1064             =cut
1065              
1066             =head1 INTEGRATES
1067              
1068             This package integrates behaviors from:
1069              
1070             L
1071              
1072             L
1073              
1074             L
1075              
1076             =cut
1077              
1078             =head1 METHODS
1079              
1080             This package provides the following methods:
1081              
1082             =cut
1083              
1084             =head2 code
1085              
1086             code() (string | undef)
1087              
1088             The code method returns the name of the value's data type.
1089              
1090             I>
1091              
1092             =over 4
1093              
1094             =item code example 1
1095              
1096             # given: synopsis;
1097              
1098             my $code = $type->code;
1099              
1100             # "ARRAY"
1101              
1102             =back
1103              
1104             =over 4
1105              
1106             =item code example 2
1107              
1108             package main;
1109              
1110             use Venus::Type;
1111              
1112             my $type = Venus::Type->new(value => {});
1113              
1114             my $code = $type->code;
1115              
1116             # "HASH"
1117              
1118             =back
1119              
1120             =over 4
1121              
1122             =item code example 3
1123              
1124             package main;
1125              
1126             use Venus::Type;
1127              
1128             my $type = Venus::Type->new(value => qr//);
1129              
1130             my $code = $type->code;
1131              
1132             # "REGEXP"
1133              
1134             =back
1135              
1136             =cut
1137              
1138             =head2 coded
1139              
1140             coded(string $code) (boolean)
1141              
1142             The coded method return true or false if the data type name provided matches
1143             the result of L.
1144              
1145             I>
1146              
1147             =over 4
1148              
1149             =item coded example 1
1150              
1151             # given: synopsis;
1152              
1153             my $coded = $type->coded('ARRAY');
1154              
1155             # 1
1156              
1157             =back
1158              
1159             =over 4
1160              
1161             =item coded example 2
1162              
1163             # given: synopsis;
1164              
1165             my $coded = $type->coded('HASH');
1166              
1167             # 0
1168              
1169             =back
1170              
1171             =cut
1172              
1173             =head2 deduce
1174              
1175             deduce() (object)
1176              
1177             The deduce methods returns the argument as a data type object.
1178              
1179             I>
1180              
1181             =over 4
1182              
1183             =item deduce example 1
1184              
1185             # given: synopsis;
1186              
1187             my $deduce = $type->deduce;
1188              
1189             # bless({ value => [] }, "Venus::Array")
1190              
1191             =back
1192              
1193             =over 4
1194              
1195             =item deduce example 2
1196              
1197             package main;
1198              
1199             use Venus::Type;
1200              
1201             my $type = Venus::Type->new(value => {});
1202              
1203             my $deduce = $type->deduce;
1204              
1205             # bless({ value => {} }, "Venus::Hash")
1206              
1207             =back
1208              
1209             =over 4
1210              
1211             =item deduce example 3
1212              
1213             package main;
1214              
1215             use Venus::Type;
1216              
1217             my $type = Venus::Type->new(value => qr//);
1218              
1219             my $deduce = $type->deduce;
1220              
1221             # bless({ value => qr// }, "Venus::Regexp")
1222              
1223             =back
1224              
1225             =over 4
1226              
1227             =item deduce example 4
1228              
1229             package main;
1230              
1231             use Venus::Type;
1232              
1233             my $type = Venus::Type->new(value => '1.23');
1234              
1235             my $deduce = $type->deduce;
1236              
1237             # bless({ value => "1.23" }, "Venus::Float")
1238              
1239             =back
1240              
1241             =cut
1242              
1243             =head2 deduce_deep
1244              
1245             deduce_deep() (object)
1246              
1247             The deduce_deep function returns any arguments as data type objects, including
1248             nested data.
1249              
1250             I>
1251              
1252             =over 4
1253              
1254             =item deduce_deep example 1
1255              
1256             package main;
1257              
1258             use Venus::Type;
1259              
1260             my $type = Venus::Type->new(value => [1..4]);
1261              
1262             my $deduce_deep = $type->deduce_deep;
1263              
1264             # bless({
1265             # value => [
1266             # bless({ value => 1 }, "Venus::Number"),
1267             # bless({ value => 2 }, "Venus::Number"),
1268             # bless({ value => 3 }, "Venus::Number"),
1269             # bless({ value => 4 }, "Venus::Number"),
1270             # ],
1271             # }, "Venus::Array")
1272              
1273             =back
1274              
1275             =over 4
1276              
1277             =item deduce_deep example 2
1278              
1279             package main;
1280              
1281             use Venus::Type;
1282              
1283             my $type = Venus::Type->new(value => {1..4});
1284              
1285             my $deduce_deep = $type->deduce_deep;
1286              
1287             # bless({
1288             # value => {
1289             # 1 => bless({ value => 2 }, "Venus::Number"),
1290             # 3 => bless({ value => 4 }, "Venus::Number"),
1291             # },
1292             # }, "Venus::Hash")
1293              
1294             =back
1295              
1296             =cut
1297              
1298             =head2 detract
1299              
1300             detract() (any)
1301              
1302             The detract method returns the argument as native Perl data type value.
1303              
1304             I>
1305              
1306             =over 4
1307              
1308             =item detract example 1
1309              
1310             package main;
1311              
1312             use Venus::Type;
1313             use Venus::Hash;
1314              
1315             my $type = Venus::Type->new(Venus::Hash->new({1..4}));
1316              
1317             my $detract = $type->detract;
1318              
1319             # { 1 => 2, 3 => 4 }
1320              
1321             =back
1322              
1323             =over 4
1324              
1325             =item detract example 2
1326              
1327             package main;
1328              
1329             use Venus::Type;
1330             use Venus::Array;
1331              
1332             my $type = Venus::Type->new(Venus::Array->new([1..4]));
1333              
1334             my $detract = $type->detract;
1335              
1336             # [1..4]
1337              
1338             =back
1339              
1340             =over 4
1341              
1342             =item detract example 3
1343              
1344             package main;
1345              
1346             use Venus::Type;
1347             use Venus::Regexp;
1348              
1349             my $type = Venus::Type->new(Venus::Regexp->new(qr/\w+/));
1350              
1351             my $detract = $type->detract;
1352              
1353             # qr/\w+/
1354              
1355             =back
1356              
1357             =over 4
1358              
1359             =item detract example 4
1360              
1361             package main;
1362              
1363             use Venus::Type;
1364             use Venus::Float;
1365              
1366             my $type = Venus::Type->new(Venus::Float->new('1.23'));
1367              
1368             my $detract = $type->detract;
1369              
1370             # "1.23"
1371              
1372             =back
1373              
1374             =cut
1375              
1376             =head2 detract_deep
1377              
1378             detract_deep() (any)
1379              
1380             The detract_deep method returns any arguments as native Perl data type values,
1381             including nested data.
1382              
1383             I>
1384              
1385             =over 4
1386              
1387             =item detract_deep example 1
1388              
1389             package main;
1390              
1391             use Venus::Type;
1392             use Venus::Hash;
1393              
1394             my $type = Venus::Type->new(Venus::Hash->new({1..4}));
1395              
1396             my $detract_deep = Venus::Type->new($type->deduce_deep)->detract_deep;
1397              
1398             # { 1 => 2, 3 => 4 }
1399              
1400             =back
1401              
1402             =over 4
1403              
1404             =item detract_deep example 2
1405              
1406             package main;
1407              
1408             use Venus::Type;
1409             use Venus::Array;
1410              
1411             my $type = Venus::Type->new(Venus::Array->new([1..4]));
1412              
1413             my $detract_deep = Venus::Type->new($type->deduce_deep)->detract_deep;
1414              
1415             # [1..4]
1416              
1417             =back
1418              
1419             =cut
1420              
1421             =head2 identify
1422              
1423             identify() (boolean, boolean, string)
1424              
1425             The identify method returns the value's data type, or L, in scalar
1426             context. In list context, this method will return a tuple with (defined,
1427             blessed, and data type) elements. B For globs and file handles this
1428             method will return "scalar" as the data type.
1429              
1430             I>
1431              
1432             =over 4
1433              
1434             =item identify example 1
1435              
1436             # given: synopsis
1437              
1438             package main;
1439              
1440             my ($defined, $blessed, $typename) = $type->identify;
1441              
1442             # (1, 0, 'ARRAY')
1443              
1444             =back
1445              
1446             =over 4
1447              
1448             =item identify example 2
1449              
1450             package main;
1451              
1452             use Venus::Type;
1453              
1454             my $type = Venus::Type->new(value => {});
1455              
1456             my ($defined, $blessed, $typename) = $type->identify;
1457              
1458             # (1, 0, 'HASH')
1459              
1460             =back
1461              
1462             =over 4
1463              
1464             =item identify example 3
1465              
1466             package main;
1467              
1468             use Venus::Type;
1469              
1470             my $type = Venus::Type->new(value => qr//);
1471              
1472             my ($defined, $blessed, $typename) = $type->identify;
1473              
1474             # (1, 1, 'REGEXP')
1475              
1476             =back
1477              
1478             =over 4
1479              
1480             =item identify example 4
1481              
1482             package main;
1483              
1484             use Venus::Type;
1485              
1486             my $type = Venus::Type->new(value => bless{});
1487              
1488             my ($defined, $blessed, $typename) = $type->identify;
1489              
1490             # (1, 1, 'OBJECT')
1491              
1492             =back
1493              
1494             =cut
1495              
1496             =head2 package
1497              
1498             package() (string)
1499              
1500             The code method returns the package name of the objectified value, i.e.
1501             C.
1502              
1503             I>
1504              
1505             =over 4
1506              
1507             =item package example 1
1508              
1509             # given: synopsis;
1510              
1511             my $package = $type->package;
1512              
1513             # "Venus::Array"
1514              
1515             =back
1516              
1517             =over 4
1518              
1519             =item package example 2
1520              
1521             package main;
1522              
1523             use Venus::Type;
1524              
1525             my $type = Venus::Type->new(value => {});
1526              
1527             my $package = $type->package;
1528              
1529             # "Venus::Hash"
1530              
1531             =back
1532              
1533             =cut
1534              
1535             =head1 AUTHORS
1536              
1537             Awncorp, C
1538              
1539             =cut
1540              
1541             =head1 LICENSE
1542              
1543             Copyright (C) 2000, Awncorp, C.
1544              
1545             This program is free software, you can redistribute it and/or modify it under
1546             the terms of the Apache license version 2.0.
1547              
1548             =cut