File Coverage

blib/lib/Hades/Realm/Mouse.pm
Criterion Covered Total %
statement 61 65 93.8
branch 28 44 63.6
condition 15 25 60.0
subroutine 10 10 100.0
pod 7 7 100.0
total 121 151 80.1


line stmt bran cond sub pod time code
1             package Hades::Realm::Mouse;
2 8     8   2504089 use strict;
  8         69  
  8         209  
3 8     8   38 use warnings;
  8         15  
  8         234  
4 8     8   38 use base qw/Hades::Realm::OO/;
  8         13  
  8         4252  
5             our $VERSION = 0.06;
6              
7             sub new {
8 14 100   14 1 15099 my ( $cls, %args ) = ( shift(), scalar @_ == 1 ? %{ $_[0] } : @_ );
  13         66  
9 14         84 my $self = $cls->SUPER::new(%args);
10 14         796 my %accessors = ();
11 14         29 for my $accessor ( keys %accessors ) {
12             my $param
13             = defined $args{$accessor}
14             ? $args{$accessor}
15 0 0       0 : $accessors{$accessor}->{default};
16             my $value
17             = $self->$accessor( $accessors{$accessor}->{builder}
18 0 0       0 ? $accessors{$accessor}->{builder}->( $self, $param )
19             : $param );
20 0 0 0     0 unless ( !$accessors{$accessor}->{required} || defined $value ) {
21 0         0 die "$accessor accessor is required";
22             }
23             }
24 14         55 return $self;
25             }
26              
27             sub build_as_role {
28 1     1 1 32998 my ( $orig, $self, @params ) = ( 'SUPER::build_as_role', @_ );
29 1         7 my @res = $self->$orig(@params);
30 1         19 $res[0]->use(q|Mouse::Role|);
31             $res[0]->use(
32             sprintf q|Types::Standard qw/%s/|,
33 1         14 join( ' ', keys %{ $self->meta->{ $self->current_class }->{types} } )
  1         5  
34             );
35              
36 1 50       25 return wantarray ? @res : $res[0];
37             }
38              
39             sub build_as_class {
40 9     9 1 61704 my ( $orig, $self, @params ) = ( 'SUPER::build_as_class', @_ );
41 9         54 my @res = $self->$orig(@params);
42 9         130 $res[0]->use(q|Mouse|);
43             $res[0]->use(
44             sprintf q|Types::Standard qw/%s/|,
45 9         99 join( ' ', keys %{ $self->meta->{ $self->current_class }->{types} } )
  9         28  
46             );
47              
48 9 50       195 return wantarray ? @res : $res[0];
49             }
50              
51             sub build_has {
52 38     38 1 3575790 my ( $self, $meta ) = @_;
53 38 100 100     131 if ( ( ref($meta) || "" ) ne "HASH" ) {
54 2 50       13 $meta = defined $meta ? $meta : 'undef';
55 2         19 die
56             qq{HashRef: invalid value $meta for variable \$meta in method build_has};
57             }
58              
59 36   50     154 $meta->{is} ||= '"rw"';
60             my $attributes = join ', ',
61 36 100       67 map { ( $meta->{$_} ? ( sprintf "%s => %s", $_, $meta->{$_} ) : () ) }
  288         591  
62             qw/is required clearer predicate isa default trigger builder/;
63 36         75 my $name = $meta->{has};
64 36         89 my $code = qq{has $name => ( $attributes );};
65 36         89 return $code;
66              
67             }
68              
69             sub build_accessor_predicate {
70 10     10 1 2571 my ( $self, $name, $content ) = @_;
71 10 100 66     57 if ( !defined($name) || ref $name ) {
72 2 50       5 $name = defined $name ? $name : 'undef';
73 2         15 die
74             qq{Str: invalid value $name for variable \$name in method build_accessor_predicate};
75             }
76 8 100 66     43 if ( !defined($content) || ref $content ) {
77 2 50       5 $content = defined $content ? $content : 'undef';
78 2         24 die
79             qq{Str: invalid value $content for variable \$content in method build_accessor_predicate};
80             }
81              
82 6         25 return qq|"has_$name"|;
83              
84             }
85              
86             sub build_accessor_clearer {
87 14     14 1 65679 my ( $self, $name, $content ) = @_;
88 14 100 66     117 if ( !defined($name) || ref $name ) {
89 2 50       4 $name = defined $name ? $name : 'undef';
90 2         16 die
91             qq{Str: invalid value $name for variable \$name in method build_accessor_clearer};
92             }
93 12 100 66     68 if ( !defined($content) || ref $content ) {
94 2 50       5 $content = defined $content ? $content : 'undef';
95 2         15 die
96             qq{Str: invalid value $content for variable \$content in method build_accessor_clearer};
97             }
98              
99 10         42 return qq|"clear_$name"|;
100              
101             }
102              
103             sub build_accessor_builder {
104 5     5 1 5552 my ( $self, $name, $content ) = @_;
105 5 100 66     28 if ( !defined($name) || ref $name ) {
106 2 50       4 $name = defined $name ? $name : 'undef';
107 2         16 die
108             qq{Str: invalid value $name for variable \$name in method build_accessor_builder};
109             }
110 3 100 66     15 if ( !defined($content) || ref $content ) {
111 2 50       7 $content = defined $content ? $content : 'undef';
112 2         15 die
113             qq{Str: invalid value $content for variable \$content in method build_accessor_builder};
114             }
115              
116 1 50       22 return $content =~ m/^\w\w+$/ ? $content : qq|"_build_$name"|;
117              
118             }
119              
120             1;
121              
122             __END__
123              
124             =head1 NAME
125              
126             Hades::Realm::Mouse - Hades realm for Mouse
127              
128             =head1 VERSION
129              
130             Version 0.01
131              
132             =cut
133              
134             =head1 SYNOPSIS
135              
136             Quick summary of what the module does:
137              
138             Hades->run({
139             eval => q|
140             Kosmos {
141             [curae penthos] :t(Int) :d(2) :pr :c :r
142             geras $nosoi :t(Int) :d(5) {
143             if (£penthos == $nosoi) {
144             return £curae;
145             }
146             }
147             }
148             |,
149             realm => 'Mouse',
150             });
151              
152             ... generates ...
153              
154             package Kosmos;
155             use strict;
156             use warnings;
157             use Mouse;
158             use Types::Standard qw/Int/;
159             our $VERSION = 0.01;
160              
161             has curae => (
162             is => "rw",
163             required => 1,
164             clearer => "clear_curae",
165             predicate => "has_curae",
166             isa => Int,
167             default => sub {2}
168             );
169              
170             has penthos => (
171             is => "rw",
172             required => 1,
173             clearer => "clear_curae",
174             predicate => "has_curae",
175             isa => Int,
176             default => sub {2}
177             );
178              
179             sub geras {
180             my ( $self, $nosoi ) = @_;
181             $nosoi = defined $nosoi ? $nosoi : 5;
182             if ( !defined($nosoi) || ref $nosoi || $nosoi !~ m/^[-+\d]\d*$/ ) {
183             $nosoi = defined $nosoi ? $nosoi : 'undef';
184             die qq{Int: invalid value $nosoi for variable \$nosoi in method geras};
185             }
186             if ( £penthos == $nosoi ) { return £curae; }
187             }
188              
189             1;
190              
191             __END__
192            
193             NOTE: coerce and private attributes currently do not work with Mouse.
194              
195             =head1 SUBROUTINES/METHODS
196              
197             =head2 new
198              
199             Instantiate a new Hades::Realm::Mouse object.
200              
201             Hades::Realm::Mouse->new
202              
203             =head2 build_as_role
204              
205             call build_as_role method.
206              
207             =head2 build_as_class
208              
209             call build_as_class method.
210              
211             =head2 build_has
212              
213             call build_has method. Expects param $meta to be a HashRef.
214              
215             $obj->build_has($meta)
216              
217             =head2 build_accessor_predicate
218              
219             call build_accessor_predicate method. Expects param $name to be a Str, param $content to be a Str.
220              
221             $obj->build_accessor_predicate($name, $content)
222              
223             =head2 build_accessor_clearer
224              
225             call build_accessor_clearer method. Expects param $name to be a Str, param $content to be a Str.
226              
227             $obj->build_accessor_clearer($name, $content)
228              
229             =head2 build_accessor_builder
230              
231             call build_accessor_builder method. Expects param $name to be a Str, param $content to be a Str.
232              
233             $obj->build_accessor_builder($name, $content)
234              
235             =head1 AUTHOR
236              
237             LNATION, C<< <email at lnation.org> >>
238              
239             =head1 BUGS
240              
241             Please report any bugs or feature requests to C<bug-hades::realm::mouse at rt.cpan.org>, or through
242             the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Hades-Realm-Mouse>. I will be notified, and then you'll
243             automatically be notified of progress on your bug as I make changes.
244              
245             =head1 SUPPORT
246              
247             You can find documentation for this module with the perldoc command.
248              
249             perldoc Hades::Realm::Mouse
250              
251             You can also look for information at:
252              
253             =over 4
254              
255             =item * RT: CPAN's request tracker (report bugs here)
256              
257             L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Hades-Realm-Mouse>
258              
259             =item * AnnoCPAN: Annotated CPAN documentation
260              
261             L<http://annocpan.org/dist/Hades-Realm-Mouse>
262              
263             =item * CPAN Ratings
264              
265             L<https://cpanratings.perl.org/d/Hades-Realm-Mouse>
266              
267             =item * Search CPAN
268              
269             L<https://metacpan.org/release/Hades-Realm-Mouse>
270              
271             =back
272              
273             =head1 ACKNOWLEDGEMENTS
274              
275             =head1 LICENSE AND COPYRIGHT
276              
277             This software is Copyright (c) 2020 by LNATION.
278              
279             This is free software, licensed under:
280              
281             The Artistic License 2.0 (GPL Compatible)
282              
283             =cut
284              
285