File Coverage

blib/lib/Hades/Realm/Mouse.pm
Criterion Covered Total %
statement 53 56 94.6
branch 21 32 65.6
condition 11 19 57.8
subroutine 9 9 100.0
pod 6 6 100.0
total 100 122 81.9


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