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