File Coverage

blib/lib/Hades/Realm/Moose.pm
Criterion Covered Total %
statement 55 58 94.8
branch 23 34 67.6
condition 11 19 57.8
subroutine 9 9 100.0
pod 6 6 100.0
total 104 126 82.5


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