File Coverage

blib/lib/Venus/Kind.pm
Criterion Covered Total %
statement 59 60 98.3
branch 13 18 72.2
condition 5 6 83.3
subroutine 17 17 100.0
pod 8 9 88.8
total 102 110 92.7


line stmt bran cond sub pod time code
1             package Venus::Kind;
2              
3 87     87   1995 use 5.018;
  87         318  
4              
5 87     87   498 use strict;
  87         186  
  87         1986  
6 87     87   450 use warnings;
  87         207  
  87         2681  
7              
8 87     87   460 use Venus::Class 'with';
  87         191  
  87         559  
9              
10             with 'Venus::Role::Boxable';
11             with 'Venus::Role::Tryable';
12             with 'Venus::Role::Catchable';
13             with 'Venus::Role::Comparable';
14             with 'Venus::Role::Deferrable';
15             with 'Venus::Role::Dumpable';
16             with 'Venus::Role::Digestable';
17             with 'Venus::Role::Doable';
18             with 'Venus::Role::Matchable';
19             with 'Venus::Role::Printable';
20             with 'Venus::Role::Reflectable';
21             with 'Venus::Role::Testable';
22             with 'Venus::Role::Throwable';
23             with 'Venus::Role::Assertable';
24             with 'Venus::Role::Serializable';
25             with 'Venus::Role::Mockable';
26              
27             # METHODS
28              
29             sub assertion {
30 97     97 1 178 my ($self) = @_;
31              
32 97         3730 require Venus::Assert;
33              
34 97   66     538 return Venus::Assert->new(ref $self || $self)->any;
35             }
36              
37             sub checksum {
38 346     346 1 752 my ($self) = @_;
39              
40 346         1233 return $self->digest('md5', 'stringified');
41             }
42              
43             sub comparer {
44 797     797 0 1548 my ($self, $operation) = @_;
45              
46 797 100       2081 if (lc($operation) eq 'eq') {
47 516         2117 return 'checksum';
48             }
49 281 100       846 if (lc($operation) eq 'gt') {
50 155         563 return 'numified';
51             }
52 126 50       384 if (lc($operation) eq 'lt') {
53 126         458 return 'numified';
54             }
55             else {
56 0         0 return 'stringified';
57             }
58             }
59              
60             sub numified {
61 663     663 1 1365 my ($self) = @_;
62              
63 663         1962 return CORE::length($self->stringified);
64             }
65              
66             sub renew {
67 583     583 1 1768 my ($self, @args) = @_;
68              
69 583         1577 my $data = $self->ARGS(@args);
70              
71 583         1021 for my $attr (@{$self->meta->attrs}) {
  583         1817  
72 2888 100 100     11516 $data->{$attr} = $self->$attr if exists $self->{$attr} && !exists $data->{$attr};
73             }
74              
75 583         1791 return $self->class->new($data);
76             }
77              
78             sub safe {
79 8     8 1 40 my ($self, $method, @args) = @_;
80              
81 8         68 my $result = $self->trap($method, @args);
82              
83 8 50       123 return(wantarray ? (@$result) : $result->[0]);
84             }
85              
86             sub self {
87 2     2 1 6 my ($self) = @_;
88              
89 2         13 return $self;
90             }
91              
92             sub stringified {
93 1341     1341 1 2512 my ($self) = @_;
94              
95 1341 100       6929 return $self->dump($self->can('value') ? 'value' : ());
96             }
97              
98             sub trap {
99 14     14 1 37 my ($self, $method, @args) = @_;
100              
101 87     87   777 no strict;
  87         218  
  87         2999  
102 87     87   540 no warnings;
  87         191  
  87         25019  
103              
104 14         48 my $result = [[],[],[]];
105              
106 14 0       60 return(wantarray ? (@$result) : $result->[0]) if !$method;
    50          
107              
108 14         126 local ($!, $?, $@, $^E);
109              
110             local $SIG{__DIE__} = sub{
111 9     9   34 push @{$result->[2]}, @_;
  9         129  
112 14         126 };
113              
114             local $SIG{__WARN__} = sub{
115 3     3   9 push @{$result->[1]}, @_;
  3         22  
116 14         94 };
117              
118 14         33 push @{$result->[0]}, eval {
  14         48  
119 14         29 local $_ = $self;
120 14         164 $self->$method(@args);
121             };
122              
123 14 100       357 return(wantarray ? (@$result) : $result->[0]);
124             }
125              
126             1;
127              
128              
129              
130             =head1 NAME
131              
132             Venus::Kind - Kind Base Class
133              
134             =cut
135              
136             =head1 ABSTRACT
137              
138             Kind Base Class for Perl 5
139              
140             =cut
141              
142             =head1 SYNOPSIS
143              
144             package Example;
145              
146             use Venus::Class;
147              
148             base 'Venus::Kind';
149              
150             package main;
151              
152             my $example = Example->new;
153              
154             # bless({}, "Example")
155              
156             =cut
157              
158             =head1 DESCRIPTION
159              
160             This package provides identity and methods common across all L classes.
161              
162             =cut
163              
164             =head1 INTEGRATES
165              
166             This package integrates behaviors from:
167              
168             L
169              
170             L
171              
172             L
173              
174             L
175              
176             L
177              
178             L
179              
180             L
181              
182             L
183              
184             L
185              
186             L
187              
188             L
189              
190             L
191              
192             L
193              
194             L
195              
196             L
197              
198             L
199              
200             =cut
201              
202             =head1 METHODS
203              
204             This package provides the following methods:
205              
206             =cut
207              
208             =head2 assertion
209              
210             assertion() (Assert)
211              
212             The assertion method returns a L object based on the invocant.
213              
214             I>
215              
216             =over 4
217              
218             =item assertion example 1
219              
220             # given: synopsis
221              
222             package main;
223              
224             my $assertion = $example->assertion;
225              
226             # bless({name => "Example"}, "Venus::Assert")
227              
228             =back
229              
230             =cut
231              
232             =head2 checksum
233              
234             checksum() (Str)
235              
236             The checksum method returns an md5 hash string representing the stringified
237             object value (or the object itself).
238              
239             I>
240              
241             =over 4
242              
243             =item checksum example 1
244              
245             # given: synopsis;
246              
247             my $checksum = $example->checksum;
248              
249             # "859a86eed4b2d97eb7b830b02f06de32"
250              
251             =back
252              
253             =over 4
254              
255             =item checksum example 2
256              
257             package Checksum::Example;
258              
259             use Venus::Class;
260              
261             base 'Venus::Kind';
262              
263             attr 'value';
264              
265             package main;
266              
267             my $example = Checksum::Example->new(value => 'example');
268              
269             my $checksum = $example->checksum;
270              
271             # "1a79a4d60de6718e8e5b326e338ae533"
272              
273             =back
274              
275             =cut
276              
277             =head2 numified
278              
279             numified() (Int)
280              
281             The numified method returns the numerical representation of the object which is
282             typically the length (or character count) of the stringified object.
283              
284             I>
285              
286             =over 4
287              
288             =item numified example 1
289              
290             # given: synopsis;
291              
292             my $numified = $example->numified;
293              
294             # 22
295              
296             =back
297              
298             =over 4
299              
300             =item numified example 2
301              
302             package Numified::Example;
303              
304             use Venus::Class;
305              
306             base 'Venus::Kind';
307              
308             attr 'value';
309              
310             package main;
311              
312             my $example = Numified::Example->new(value => 'example');
313              
314             my $numified = $example->numified;
315              
316             # 7
317              
318             =back
319              
320             =cut
321              
322             =head2 renew
323              
324             renew(Any @args) (Object)
325              
326             The renew method returns a new instance of the invocant by instantiating the
327             underlying class passing all recognized class attributes to the constructor.
328             B This method is not analogous to C, i.e. attributes which are
329             references will be passed to the new object as references.
330              
331             I>
332              
333             =over 4
334              
335             =item renew example 1
336              
337             # given: synopsis
338              
339             package main;
340              
341             my $renew = $example->renew;
342              
343             # bless({}, "Example")
344              
345             =back
346              
347             =over 4
348              
349             =item renew example 2
350              
351             package Example;
352              
353             use Venus::Class;
354              
355             base 'Venus::Kind';
356              
357             attr 'values';
358              
359             package main;
360              
361             my $example = Example->new(values => [1,2]);
362              
363             my $renew = $example->renew;
364              
365             # bless({values => [1,2]}, "Example")
366              
367             =back
368              
369             =over 4
370              
371             =item renew example 3
372              
373             package Example;
374              
375             use Venus::Class;
376              
377             base 'Venus::Kind';
378              
379             attr 'keys';
380             attr 'values';
381              
382             package main;
383              
384             my $example = Example->new(values => [1,2]);
385              
386             my $renew = $example->renew(keys => ['a','b']);
387              
388             # bless({keys => ["a","b"], values => [1,2]}, "Example")
389              
390             =back
391              
392             =cut
393              
394             =head2 safe
395              
396             safe(Str | CodeRef $code, Any @args) (Any)
397              
398             The safe method dispatches the method call or executes the callback and returns
399             the result, supressing warnings and exceptions. If an exception is thrown this
400             method will return C. This method supports dispatching, i.e. providing a
401             method name and arguments whose return value will be acted on by this method.
402              
403             I>
404              
405             =over 4
406              
407             =item safe example 1
408              
409             # given: synopsis;
410              
411             my $safe = $example->safe('class');
412              
413             # "Example"
414              
415             =back
416              
417             =over 4
418              
419             =item safe example 2
420              
421             # given: synopsis;
422              
423             my $safe = $example->safe(sub {
424             ${_}->class / 2
425             });
426              
427             # '0'
428              
429             =back
430              
431             =over 4
432              
433             =item safe example 3
434              
435             # given: synopsis;
436              
437             my $safe = $example->safe(sub {
438             die;
439             });
440              
441             # undef
442              
443             =back
444              
445             =cut
446              
447             =head2 self
448              
449             self() (Any)
450              
451             The self method returns the invocant.
452              
453             I>
454              
455             =over 4
456              
457             =item self example 1
458              
459             # given: synopsis
460              
461             package main;
462              
463             my $self = $example->self;
464              
465             # bless({}, "Example")
466              
467             =back
468              
469             =cut
470              
471             =head2 stringified
472              
473             stringified() (Str)
474              
475             The stringified method returns the object, stringified (i.e. a dump of the
476             object's value).
477              
478             I>
479              
480             =over 4
481              
482             =item stringified example 1
483              
484             # given: synopsis;
485              
486             my $stringified = $example->stringified;
487              
488             # bless({}, 'Example')
489              
490              
491              
492              
493             =back
494              
495             =over 4
496              
497             =item stringified example 2
498              
499             package Stringified::Example;
500              
501             use Venus::Class;
502              
503             base 'Venus::Kind';
504              
505             attr 'value';
506              
507             package main;
508              
509             my $example = Stringified::Example->new(value => 'example');
510              
511             my $stringified = $example->stringified;
512              
513             # "example"
514              
515             =back
516              
517             =cut
518              
519             =head2 trap
520              
521             trap(Str | CodeRef $code, Any @args) (Tuple[ArrayRef, ArrayRef, ArrayRef])
522              
523             The trap method dispatches the method call or executes the callback and returns
524             a tuple (i.e. a 3-element arrayref) with the results, warnings, and exceptions
525             from the code execution. If an exception is thrown, the results (i.e. the
526             1st-element) will be an empty arrayref. This method supports dispatching, i.e.
527             providing a method name and arguments whose return value will be acted on by
528             this method.
529              
530             I>
531              
532             =over 4
533              
534             =item trap example 1
535              
536             # given: synopsis;
537              
538             my $result = $example->trap('class');
539              
540             # ["Example"]
541              
542             =back
543              
544             =over 4
545              
546             =item trap example 2
547              
548             # given: synopsis;
549              
550             my ($results, $warnings, $errors) = $example->trap('class');
551              
552             # (["Example"], [], [])
553              
554             =back
555              
556             =over 4
557              
558             =item trap example 3
559              
560             # given: synopsis;
561              
562             my $trap = $example->trap(sub {
563             ${_}->class / 2
564             });
565              
566             # ["0"]
567              
568             =back
569              
570             =over 4
571              
572             =item trap example 4
573              
574             # given: synopsis;
575              
576             my ($results, $warnings, $errors) = $example->trap(sub {
577             ${_}->class / 2
578             });
579              
580             # (["0"], ["Argument ... isn't numeric in division ..."], [])
581              
582             =back
583              
584             =over 4
585              
586             =item trap example 5
587              
588             # given: synopsis;
589              
590             my $trap = $example->trap(sub {
591             die;
592             });
593              
594             # []
595              
596             =back
597              
598             =over 4
599              
600             =item trap example 6
601              
602             # given: synopsis;
603              
604             my ($results, $warnings, $errors) = $example->trap(sub {
605             die;
606             });
607              
608             # ([], [], ["Died..."])
609              
610             =back
611              
612             =cut
613              
614             =head1 AUTHORS
615              
616             Awncorp, C
617              
618             =cut
619              
620             =head1 LICENSE
621              
622             Copyright (C) 2000, Al Newkirk.
623              
624             This program is free software, you can redistribute it and/or modify it under
625             the terms of the Apache license version 2.0.
626              
627             =cut