File Coverage

blib/lib/Hades/Realm/Moose.pm
Criterion Covered Total %
statement 63 67 94.0
branch 30 46 65.2
condition 15 25 60.0
subroutine 10 10 100.0
pod 7 7 100.0
total 125 155 80.6


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