File Coverage

blib/lib/Hades/Realm/Moo.pm
Criterion Covered Total %
statement 39 42 92.8
branch 9 16 56.2
condition 3 7 42.8
subroutine 7 7 100.0
pod 4 4 100.0
total 62 76 81.5


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