File Coverage

blib/lib/Hades/Macro.pm
Criterion Covered Total %
statement 51 52 98.0
branch 25 28 89.2
condition 12 14 85.7
subroutine 7 7 100.0
pod 5 5 100.0
total 100 106 94.3


line stmt bran cond sub pod time code
1             package Hades::Macro;
2 5     5   71664 use strict;
  5         17  
  5         135  
3 5     5   22 use warnings;
  5         11  
  5         3169  
4             our $VERSION = 0.19;
5              
6             sub new {
7 63 100   63 1 18020 my ( $cls, %args ) = ( shift(), scalar @_ == 1 ? %{ $_[0] } : @_ );
  14         50  
8 63         157 my $self = bless {}, $cls;
9 63         254 my %accessors = ( alias => {}, macro => { default => [], }, );
10 63         256 for my $accessor ( keys %accessors ) {
11             my $param
12             = defined $args{$accessor}
13             ? $args{$accessor}
14 121 100       314 : $accessors{$accessor}->{default};
15             my $value
16             = $self->$accessor( $accessors{$accessor}->{builder}
17 121 50       514 ? $accessors{$accessor}->{builder}->( $self, $param )
18             : $param );
19 110 50 33     366 unless ( !$accessors{$accessor}->{required} || defined $value ) {
20 0         0 die "$accessor accessor is required";
21             }
22             }
23 52         327 return $self;
24             }
25              
26             sub macro {
27 19     19 1 1335 my ( $self, $value ) = @_;
28 19 100       42 if ( defined $value ) {
29 17 100 100     62 if ( ( ref($value) || "" ) ne "ARRAY" ) {
30 4         38 die qq{ArrayRef: invalid value $value for accessor macro};
31             }
32 13         24 $self->{macro} = $value;
33             }
34 15         46 return $self->{macro};
35             }
36              
37             sub alias {
38 74     74 1 3403 my ( $self, $value ) = @_;
39 74 100       208 if ( defined $value ) {
40 17 100 100     57 if ( ( ref($value) || "" ) ne "HASH" ) {
41 4         62 die
42             qq{HashRef[ArrayRef]: invalid value $value for accessor alias};
43             }
44 13         15 for my $item ( values %{$value} ) {
  13         32  
45 14 100 100     69 if ( !defined($item) || ( ref($item) || "" ) ne "ARRAY" ) {
      100        
46 6 100       14 $item = defined $item ? $item : 'undef';
47 6         60 die
48             qq{HashRef[ArrayRef]: invalid value $item for accessor alias expected ArrayRef};
49             }
50             }
51 7         16 $self->{alias} = $value;
52             }
53 64         178 return $self->{alias};
54             }
55              
56             sub has_alias {
57 4     4 1 10 my ($self) = @_;
58 4         14 return exists $self->{alias};
59             }
60              
61             sub meta {
62 4     4 1 654 my ( $self, $meta ) = @_;
63 4 100       11 $meta = defined $meta ? $meta : {};
64 4 100 100     22 if ( ( ref($meta) || "" ) ne "HASH" ) {
65 2 50       5 $meta = defined $meta ? $meta : 'undef';
66 2         22 die
67             qq{HashRef: invalid value $meta for variable \$meta in method meta};
68             }
69              
70 2         4 my $cls = ref $self;
71 2         2 for my $m ( @{ $self->macro } ) {
  2         12  
72             $meta->{$m} = {
73             meta => 'MACRO',
74 29         331 code => \&{"${cls}::${m}"},
  29         87  
75             };
76             }
77 2 100       8 if ( $self->has_alias ) {
78 1         1 for my $key ( %{ $self->alias } ) {
  1         2  
79 4         4 for my $alias ( @{ $self->alias()->{$key} } ) {
  4         6  
80 2         4 $meta->{$alias} = $meta->{$key};
81             }
82             }
83             }
84 2         6 return $meta;
85              
86             }
87              
88             1;
89              
90             __END__
91              
92             =head1 NAME
93              
94             Hades::Macro - Hades macro base class.
95              
96             =head1 VERSION
97              
98             Version 0.01
99              
100             =cut
101              
102             =head1 SYNOPSIS
103              
104             Quick summary of what the module does:
105              
106             Hades::Macro::Kosmos base Hades::Macro {
107             macro :t(ArrayRef) :d([qw/geras/])
108             geras $mg :t(Object) {
109             return q|...|;
110             }
111             }
112              
113             =head1 SUBROUTINES/METHODS
114              
115             =head2 new
116              
117             Instantiate a new Hades::Macro object.
118              
119             Hades::Macro->new
120              
121             =head2 has_alias
122              
123             has_alias will return true if alias accessor has a value.
124              
125             $obj->has_alias
126              
127             =head2 meta
128              
129             call meta method. Expects param $meta to be a HashRef.
130              
131             $obj->meta($meta)
132              
133             =head1 ACCESSORS
134              
135             =head2 macro
136              
137             get or set macro.
138              
139             $obj->macro;
140              
141             $obj->macro($value);
142              
143             =head2 alias
144              
145             get or set alias.
146              
147             $obj->alias;
148              
149             $obj->alias($value);
150              
151             =head1 AUTHOR
152              
153             LNATION, C<< <email at lnation.org> >>
154              
155             =head1 BUGS
156              
157             Please report any bugs or feature requests to C<bug-hades::macro at rt.cpan.org>, or through
158             the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Hades-Macro>. I will be notified, and then you'll
159             automatically be notified of progress on your bug as I make changes.
160              
161             =head1 SUPPORT
162              
163             You can find documentation for this module with the perldoc command.
164              
165             perldoc Hades::Macro
166              
167             You can also look for information at:
168              
169             =over 4
170              
171             =item * RT: CPAN's request tracker (report bugs here)
172              
173             L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Hades-Macro>
174              
175             =item * AnnoCPAN: Annotated CPAN documentation
176              
177             L<http://annocpan.org/dist/Hades-Macro>
178              
179             =item * CPAN Ratings
180              
181             L<https://cpanratings.perl.org/d/Hades-Macro>
182              
183             =item * Search CPAN
184              
185             L<https://metacpan.org/release/Hades-Macro>
186              
187             =back
188              
189             =head1 ACKNOWLEDGEMENTS
190              
191             =head1 LICENSE AND COPYRIGHT
192              
193             This software is Copyright (c) 2020 by LNATION.
194              
195             This is free software, licensed under:
196              
197             The Artistic License 2.0 (GPL Compatible)
198              
199             =cut
200              
201