File Coverage

blib/lib/Hades/Macro/Dolos.pm
Criterion Covered Total %
statement 241 283 85.1
branch 172 272 63.2
condition 102 157 64.9
subroutine 29 29 100.0
pod 26 26 100.0
total 570 767 74.3


line stmt bran cond sub pod time code
1             package Hades::Macro::Dolos;
2 2     2   72859 use strict;
  2         14  
  2         60  
3 2     2   10 use warnings;
  2         3  
  2         60  
4 2     2   10 use base qw/Hades::Macro/;
  2         4  
  2         1012  
5             our $VERSION = 0.19;
6              
7             sub new {
8 33 100   33 1 83777 my ( $cls, %args ) = ( shift(), scalar @_ == 1 ? %{ $_[0] } : @_ );
  30         121  
9 33         166 my $self = $cls->SUPER::new(%args);
10 31         260 my %accessors = (
11             macro => {
12             default => [
13             qw/
14             autoload_cb
15             caller
16             clear_unless_keys
17             call_sub
18             call_sub_my
19             delete
20             die_unless_keys
21             else
22             elsif
23             export
24             for
25             foreach
26             for_keys
27             for_key_exists_and_return
28             grep
29             grep_map
30             if
31             map
32             map_grep
33             maybe
34             merge_hash_refs
35             require
36             unless
37             while
38             /
39             ],
40             },
41             );
42 31         93 for my $accessor ( keys %accessors ) {
43             my $param
44             = defined $args{$accessor}
45             ? $args{$accessor}
46 31 100       104 : $accessors{$accessor}->{default};
47             my $value
48             = $self->$accessor( $accessors{$accessor}->{builder}
49 31 50       108 ? $accessors{$accessor}->{builder}->( $self, $param )
50             : $param );
51 31 50 33     127 unless ( !$accessors{$accessor}->{required} || defined $value ) {
52 0         0 die "$accessor accessor is required";
53             }
54             }
55 31         245 return $self;
56             }
57              
58             sub macro {
59 70     70 1 1539 my ( $self, $value ) = @_;
60 70 100       169 if ( defined $value ) {
61 67 100 100     242 if ( ( ref($value) || "" ) ne "ARRAY" ) {
62 4         40 die qq{ArrayRef: invalid value $value for accessor macro};
63             }
64 63         162 $self->{macro} = $value;
65             }
66 66         192 return $self->{macro};
67             }
68              
69             sub autoload_cb {
70 4     4 1 1999 my ( $self, $mg, $cb ) = @_;
71 4 100 100     40 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
72 2 50       9 $mg = defined $mg ? $mg : 'undef';
73 2         23 die
74             qq{Object: invalid value $mg for variable \$mg in method autoload_cb};
75             }
76 2 50 33     13 if ( !defined($cb) || ref $cb ) {
77 2 50       7 $cb = defined $cb ? $cb : 'undef';
78 2         19 die
79             qq{Str: invalid value $cb for variable \$cb in method autoload_cb};
80             }
81              
82 0         0 return qq|
83             my (\$cls, \$vn) = (ref \$_[0], q{[^:'[:cntrl:]]{0,1024}});
84             our \$AUTOLOAD =~ /^\${cls}::(\$vn)\$/;
85             return ${cb}(\$1) if \$1;
86             |;
87              
88             }
89              
90             sub caller {
91 4     4 1 2025 my ( $self, $mg, $variable ) = @_;
92 4 100 100     41 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
93 2 50       8 $mg = defined $mg ? $mg : 'undef';
94 2         25 die qq{Object: invalid value $mg for variable \$mg in method caller};
95             }
96 2 50       7 $variable = defined $variable ? $variable : q|$caller|;
97 2 50 33     14 if ( !defined($variable) || ref $variable ) {
98 2 50       5 $variable = defined $variable ? $variable : 'undef';
99 2         20 die
100             qq{Str: invalid value $variable for variable \$variable in method caller};
101             }
102              
103 0         0 return qq|my $variable = caller();|;
104              
105             }
106              
107             sub clear_unless_keys {
108 6     6 1 3227 my ( $self, $mg, $variable, $hash ) = @_;
109 6 100 100     46 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
110 2 50       7 $mg = defined $mg ? $mg : 'undef';
111 2         23 die
112             qq{Object: invalid value $mg for variable \$mg in method clear_unless_keys};
113             }
114 4 100 66     24 if ( !defined($variable) || ref $variable ) {
115 2 50       47 $variable = defined $variable ? $variable : 'undef';
116 2         23 die
117             qq{Str: invalid value $variable for variable \$variable in method clear_unless_keys};
118             }
119 2 50 33     11 if ( !defined($hash) || ref $hash ) {
120 2 50       7 $hash = defined $hash ? $hash : 'undef';
121 2         21 die
122             qq{Str: invalid value $hash for variable \$hash in method clear_unless_keys};
123             }
124              
125             return
126 0         0 qq|$variable = undef if (! ref $hash \|\| ! scalar keys \%{$hash});|;
127              
128             }
129              
130             sub call_sub {
131 2     2 1 678 my ( $self, $mg, $sub, @params ) = @_;
132 2 50 100     24 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
133 2 50       7 $mg = defined $mg ? $mg : 'undef';
134 2         22 die
135             qq{Object: invalid value $mg for variable \$mg in method call_sub};
136             }
137              
138 0         0 my $p = join ", ", @params;
139 0         0 return qq|${sub}($p);|;
140              
141             }
142              
143             sub call_sub_my {
144 4     4 1 2025 my ( $self, $mg, $my, $sub, @params ) = @_;
145 4 100 100     36 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
146 2 50       10 $mg = defined $mg ? $mg : 'undef';
147 2         27 die
148             qq{Object: invalid value $mg for variable \$mg in method call_sub_my};
149             }
150 2 50 33     14 if ( !defined($my) || ref $my ) {
151 2 50       9 $my = defined $my ? $my : 'undef';
152 2         20 die
153             qq{Str: invalid value $my for variable \$my in method call_sub_my};
154             }
155              
156 0         0 my $p = join ", ", @params;
157 0         0 return qq|my (${my}) = ${sub}($p);|;
158              
159             }
160              
161             sub delete {
162 12     12 1 7079 my ( $self, $mg, $hash, $key, $variable, $or, $list ) = @_;
163 12 100 100     88 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
164 2 50       8 $mg = defined $mg ? $mg : 'undef';
165 2         20 die qq{Object: invalid value $mg for variable \$mg in method delete};
166             }
167 10 100 66     65 if ( !defined($hash) || ref $hash ) {
168 2 50       6 $hash = defined $hash ? $hash : 'undef';
169 2         20 die qq{Str: invalid value $hash for variable \$hash in method delete};
170             }
171 8 100 66     27 if ( !defined($key) || ref $key ) {
172 2 50       7 $key = defined $key ? $key : 'undef';
173 2         20 die qq{Str: invalid value $key for variable \$key in method delete};
174             }
175 6 100       13 if ( defined $variable ) {
176 2 50       7 if ( ref $variable ) {
177 2         22 die
178             qq{Optional[Str]: invalid value $variable for variable \$variable in method delete};
179             }
180             }
181 4 100       13 if ( defined $or ) {
182 2 50       8 if ( ref $or ) {
183 2         19 die
184             qq{Optional[Str]: invalid value $or for variable \$or in method delete};
185             }
186             }
187 2 50       7 if ( defined $list ) {
188 2         5 my $ref = ref $list;
189 2 0 50     11 if ( ( $ref || 'SCALAR' ) ne 'SCALAR'
    50 33        
190             || ( $ref ? $$list : $list ) !~ m/^(1|0)$/ )
191             {
192 2         19 die
193             qq{Optional[Bool]: invalid value $list for variable \$list in method delete};
194             }
195 0 0       0 $list = !!( $ref ? $$list : $list ) ? 1 : 0;
    0          
196             }
197              
198 0         0 my $code = q||;
199 0 0       0 $code .= qq|$variable = | if $variable;
200 0         0 $code .= qq|delete $hash\->{$key}|;
201 0 0       0 $code .= qq| \|\| $or| if $or;
202 0 0       0 $code .= $list ? q|,| : qq|;|;
203 0         0 return $code;
204              
205             }
206              
207             sub die_unless_keys {
208 6     6 1 3385 my ( $self, $mg, $hash, $error ) = @_;
209 6 100 100     52 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
210 2 50       8 $mg = defined $mg ? $mg : 'undef';
211 2         24 die
212             qq{Object: invalid value $mg for variable \$mg in method die_unless_keys};
213             }
214 4 100 66     24 if ( !defined($hash) || ref $hash ) {
215 2 50       7 $hash = defined $hash ? $hash : 'undef';
216 2         21 die
217             qq{Str: invalid value $hash for variable \$hash in method die_unless_keys};
218             }
219 2 50       8 $error = defined $error ? $error : "hash is empty";
220 2 50 33     10 if ( !defined($error) || ref $error ) {
221 2 50       7 $error = defined $error ? $error : 'undef';
222 2         18 die
223             qq{Str: invalid value $error for variable \$error in method die_unless_keys};
224             }
225              
226 0         0 return qq|die "$error" if (! ref $hash \|\| ! scalar keys \%{$hash});|;
227              
228             }
229              
230             sub else {
231 3     3 1 667 my ( $self, $mg, @code ) = @_;
232 3 100 100     26 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
233 2 50       6 $mg = defined $mg ? $mg : 'undef';
234 2         23 die qq{Object: invalid value $mg for variable \$mg in method else};
235             }
236              
237 1         3 my $c = join "\n", @code;
238 1         4 return qq|else { $c }|;
239              
240             }
241              
242             sub elsif {
243 5     5 1 1943 my ( $self, $mg, $condition, @code ) = @_;
244 5 100 100     41 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
245 2 50       9 $mg = defined $mg ? $mg : 'undef';
246 2         23 die qq{Object: invalid value $mg for variable \$mg in method elsif};
247             }
248 3 100 66     28 if ( !defined($condition) || ref $condition ) {
249 2 50       7 $condition = defined $condition ? $condition : 'undef';
250 2         20 die
251             qq{Str: invalid value $condition for variable \$condition in method elsif};
252             }
253              
254 1         3 my $c = join "\n", @code;
255 1         33 return qq|elsif ($condition) { $c }|;
256              
257             }
258              
259             sub export {
260 10     10 1 6358 my ( $self, $mg, $method, $code, $no_warnings, $caller ) = @_;
261 10 100 100     82 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
262 2 50       7 $mg = defined $mg ? $mg : 'undef';
263 2         20 die qq{Object: invalid value $mg for variable \$mg in method export};
264             }
265 8 100 66     40 if ( !defined($method) || ref $method ) {
266 2 50       7 $method = defined $method ? $method : 'undef';
267 2         21 die
268             qq{Str: invalid value $method for variable \$method in method export};
269             }
270 6 100 66     24 if ( !defined($code) || ref $code ) {
271 2 50       6 $code = defined $code ? $code : 'undef';
272 2         19 die qq{Str: invalid value $code for variable \$code in method export};
273             }
274 4 50       10 $no_warnings = defined $no_warnings ? $no_warnings : 1;
275 4 100 66     33 if ( !defined($no_warnings)
      100        
276             || ref $no_warnings
277             || $no_warnings !~ m/^[-+\d]\d*$/ )
278             {
279 2 50       9 $no_warnings = defined $no_warnings ? $no_warnings : 'undef';
280 2         19 die
281             qq{Int: invalid value $no_warnings for variable \$no_warnings in method export};
282             }
283 2 50       7 $caller = defined $caller ? $caller : '$caller';
284 2 50 33     11 if ( !defined($caller) || ref $caller ) {
285 2 50       5 $caller = defined $caller ? $caller : 'undef';
286 2         20 die
287             qq{Str: invalid value $caller for variable \$caller in method export};
288             }
289              
290 0 0       0 my $c
291             = $no_warnings
292             ? qq|no strict "refs"; no warnings "redefine";|
293             : q||;
294 0         0 $caller =~ s/\$([^: ]+)/\${$1}/g;
295 0         0 $method =~ s/\$([^: ]+)/\${$1}/g;
296 0         0 return $c . qq|*{ "${caller}::${method}" } = sub { $code };|;
297              
298             }
299              
300             sub for {
301 4     4 1 1994 my ( $self, $mg, $condition, @code ) = @_;
302 4 100 100     38 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
303 2 50       7 $mg = defined $mg ? $mg : 'undef';
304 2         23 die qq{Object: invalid value $mg for variable \$mg in method for};
305             }
306 2 50 33     13 if ( !defined($condition) || ref $condition ) {
307 2 50       6 $condition = defined $condition ? $condition : 'undef';
308 2         20 die
309             qq{Str: invalid value $condition for variable \$condition in method for};
310             }
311              
312 0         0 my $c = join "\n", @code;
313 0         0 return qq|for ($condition) { $c }|;
314              
315             }
316              
317             sub foreach {
318 4     4 1 1977 my ( $self, $mg, $condition, @code ) = @_;
319 4 100 100     36 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
320 2 50       9 $mg = defined $mg ? $mg : 'undef';
321 2         19 die qq{Object: invalid value $mg for variable \$mg in method foreach};
322             }
323 2 50 33     13 if ( !defined($condition) || ref $condition ) {
324 2 50       6 $condition = defined $condition ? $condition : 'undef';
325 2         34 die
326             qq{Str: invalid value $condition for variable \$condition in method foreach};
327             }
328              
329 0         0 my $c = join "\n", @code;
330 0         0 return qq|foreach ($condition) { $c }|;
331              
332             }
333              
334             sub for_keys {
335 6     6 1 3253 my ( $self, $mg, $hash, $key, @code ) = @_;
336 6 100 100     53 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
337 2 50       8 $mg = defined $mg ? $mg : 'undef';
338 2         21 die
339             qq{Object: invalid value $mg for variable \$mg in method for_keys};
340             }
341 4 100 66     23 if ( !defined($hash) || ref $hash ) {
342 2 50       7 $hash = defined $hash ? $hash : 'undef';
343 2         20 die
344             qq{Str: invalid value $hash for variable \$hash in method for_keys};
345             }
346 2 50       6 $key = defined $key ? $key : $key;
347 2 50 33     10 if ( !defined($key) || ref $key ) {
348 2 50       6 $key = defined $key ? $key : 'undef';
349 2         21 die qq{Str: invalid value $key for variable \$key in method for_keys};
350             }
351              
352 0         0 $hash =~ s/^\$([^\(\{\-\:\ ]+)$/\%{\$$1}/;
353 0         0 my $c = join "\n", @code;
354 0         0 return qq|for my $key (keys $hash) { $c }|;
355              
356             }
357              
358             sub for_key_exists_and_return {
359 6     6 1 3203 my ( $self, $mg, $hash, $for ) = @_;
360 6 100 100     49 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
361 2 50       9 $mg = defined $mg ? $mg : 'undef';
362 2         22 die
363             qq{Object: invalid value $mg for variable \$mg in method for_key_exists_and_return};
364             }
365 4 100 66     21 if ( !defined($hash) || ref $hash ) {
366 2 50       7 $hash = defined $hash ? $hash : 'undef';
367 2         21 die
368             qq{Str: invalid value $hash for variable \$hash in method for_key_exists_and_return};
369             }
370 2 50 33     12 if ( !defined($for) || ref $for ) {
371 2 50       7 $for = defined $for ? $for : 'undef';
372 2         28 die
373             qq{Str: invalid value $for for variable \$for in method for_key_exists_and_return};
374             }
375              
376 0         0 return qq|\$_ && exists ${hash}->{\$_} and return ${hash}->{\$_}
377             for ($for);|;
378              
379             }
380              
381             sub grep {
382 4     4 1 1983 my ( $self, $mg, $condition, @code ) = @_;
383 4 100 100     40 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
384 2 50       6 $mg = defined $mg ? $mg : 'undef';
385 2         23 die qq{Object: invalid value $mg for variable \$mg in method grep};
386             }
387 2 50 33     16 if ( !defined($condition) || ref $condition ) {
388 2 50       8 $condition = defined $condition ? $condition : 'undef';
389 2         20 die
390             qq{Str: invalid value $condition for variable \$condition in method grep};
391             }
392              
393 0         0 my $c = join "\n", @code;
394 0         0 return qq|grep { $c } $condition|;
395              
396             }
397              
398             sub grep_map {
399 6     6 1 3242 my ( $self, $mg, $condition, $grep_code, @map_code ) = @_;
400 6 100 100     48 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
401 2 50       7 $mg = defined $mg ? $mg : 'undef';
402 2         19 die
403             qq{Object: invalid value $mg for variable \$mg in method grep_map};
404             }
405 4 100 66     23 if ( !defined($condition) || ref $condition ) {
406 2 50       7 $condition = defined $condition ? $condition : 'undef';
407 2         19 die
408             qq{Str: invalid value $condition for variable \$condition in method grep_map};
409             }
410 2 50 33     12 if ( !defined($grep_code) || ref $grep_code ) {
411 2 50       7 $grep_code = defined $grep_code ? $grep_code : 'undef';
412 2         21 die
413             qq{Str: invalid value $grep_code for variable \$grep_code in method grep_map};
414             }
415              
416 0         0 my $mc = join "\n", @map_code;
417 0         0 return qq|map { $mc } grep { $grep_code } $condition|;
418              
419             }
420              
421             sub if {
422 6     6 1 2124 my ( $self, $mg, $condition, @code ) = @_;
423 6 100 100     46 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
424 2 50       6 $mg = defined $mg ? $mg : 'undef';
425 2         22 die qq{Object: invalid value $mg for variable \$mg in method if};
426             }
427 4 100 66     24 if ( !defined($condition) || ref $condition ) {
428 2 50       14 $condition = defined $condition ? $condition : 'undef';
429 2         21 die
430             qq{Str: invalid value $condition for variable \$condition in method if};
431             }
432              
433 2         6 my $c = join "\n", @code;
434 2         7 return qq|if ($condition) { $c }|;
435              
436             }
437              
438             sub map {
439 4     4 1 2101 my ( $self, $mg, $condition, @code ) = @_;
440 4 100 100     36 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
441 2 50       7 $mg = defined $mg ? $mg : 'undef';
442 2         21 die qq{Object: invalid value $mg for variable \$mg in method map};
443             }
444 2 50 33     15 if ( !defined($condition) || ref $condition ) {
445 2 50       6 $condition = defined $condition ? $condition : 'undef';
446 2         20 die
447             qq{Str: invalid value $condition for variable \$condition in method map};
448             }
449              
450 0         0 my $c = join "\n", @code;
451 0         0 return qq|map { $c } $condition|;
452              
453             }
454              
455             sub map_grep {
456 6     6 1 3160 my ( $self, $mg, $condition, $grep_code, @map_code ) = @_;
457 6 100 100     50 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
458 2 50       8 $mg = defined $mg ? $mg : 'undef';
459 2         19 die
460             qq{Object: invalid value $mg for variable \$mg in method map_grep};
461             }
462 4 100 66     26 if ( !defined($condition) || ref $condition ) {
463 2 50       7 $condition = defined $condition ? $condition : 'undef';
464 2         19 die
465             qq{Str: invalid value $condition for variable \$condition in method map_grep};
466             }
467 2 50 33     11 if ( !defined($grep_code) || ref $grep_code ) {
468 2 50       7 $grep_code = defined $grep_code ? $grep_code : 'undef';
469 2         21 die
470             qq{Str: invalid value $grep_code for variable \$grep_code in method map_grep};
471             }
472              
473 0         0 my $mc = join "\n", @map_code;
474 0         0 return qq|grep { $grep_code } map { $mc } $condition|;
475              
476             }
477              
478             sub maybe {
479 6     6 1 3257 my ( $self, $mg, $key, $variable ) = @_;
480 6 100 100     53 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
481 2 50       8 $mg = defined $mg ? $mg : 'undef';
482 2         29 die qq{Object: invalid value $mg for variable \$mg in method maybe};
483             }
484 4 100 66     26 if ( !defined($key) || ref $key ) {
485 2 50       7 $key = defined $key ? $key : 'undef';
486 2         21 die qq{Str: invalid value $key for variable \$key in method maybe};
487             }
488 2 50 33     13 if ( !defined($variable) || ref $variable ) {
489 2 50       16 $variable = defined $variable ? $variable : 'undef';
490 2         20 die
491             qq{Str: invalid value $variable for variable \$variable in method maybe};
492             }
493              
494 0         0 return qq|(defined $variable ? ( $key => $variable ) : ())|;
495              
496             }
497              
498             sub merge_hash_refs {
499 4     4 1 757 my ( $self, $mg, @hashes ) = @_;
500 4 100 100     45 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
501 2 50       6 $mg = defined $mg ? $mg : 'undef';
502 2         27 die
503             qq{Object: invalid value $mg for variable \$mg in method merge_hash_refs};
504             }
505              
506 2         5 my $base = $hashes[0];
507 2         4 my $merge = join ', ', map { '%{' . $_ . '}' } @hashes;
  4         13  
508 2         8 return qq|$base = { $merge };|;
509              
510             }
511              
512             sub require {
513 4     4 1 1968 my ( $self, $mg, $variable ) = @_;
514 4 100 100     61 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
515 2 50       9 $mg = defined $mg ? $mg : 'undef';
516 2         19 die qq{Object: invalid value $mg for variable \$mg in method require};
517             }
518 2 50 33     13 if ( !defined($variable) || ref $variable ) {
519 2 50       8 $variable = defined $variable ? $variable : 'undef';
520 2         20 die
521             qq{Str: invalid value $variable for variable \$variable in method require};
522             }
523              
524 0         0 return qq|eval "require ${variable}";|;
525              
526             }
527              
528             sub unless {
529 4     4 1 2215 my ( $self, $mg, $condition, @code ) = @_;
530 4 100 100     37 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
531 2 50       22 $mg = defined $mg ? $mg : 'undef';
532 2         28 die qq{Object: invalid value $mg for variable \$mg in method unless};
533             }
534 2 50 33     15 if ( !defined($condition) || ref $condition ) {
535 2 50       7 $condition = defined $condition ? $condition : 'undef';
536 2         21 die
537             qq{Str: invalid value $condition for variable \$condition in method unless};
538             }
539              
540 0         0 my $c = join "\n", @code;
541 0         0 return qq|unless ($condition) { $c }|;
542              
543             }
544              
545             sub while {
546 4     4 1 1965 my ( $self, $mg, $condition, @code ) = @_;
547 4 100 100     42 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
548 2 50       8 $mg = defined $mg ? $mg : 'undef';
549 2         19 die qq{Object: invalid value $mg for variable \$mg in method while};
550             }
551 2 50 33     14 if ( !defined($condition) || ref $condition ) {
552 2 50       7 $condition = defined $condition ? $condition : 'undef';
553 2         22 die
554             qq{Str: invalid value $condition for variable \$condition in method while};
555             }
556              
557 0           my $c = join "\n", @code;
558 0           return qq|while ($condition) { $c }|;
559              
560             }
561              
562             1;
563              
564             __END__
565              
566             =head1 NAME
567              
568             Hades::Macro::Dolos - Hades macro helpers for Dolos
569              
570             =head1 VERSION
571              
572             Version 0.01
573              
574             =cut
575              
576             =head1 SYNOPSIS
577              
578             Quick summary of what the module does:
579              
580             Hades->run({
581             eval => q|
582             macro {
583             Dolos
584             }
585             Kosmos {
586             psyche $dolos :t(Int) $eros :t(HashRef) $psyche :t(HashRef) {
587             €if($dolos,€if($dolos > 10, return $eros;);, €elsif($dolos > 5, €merge_hash_refs($eros, $psyche););,
588             €else(return $psyche;););
589             return undef;
590             }
591             }
592             |;
593             });
594              
595             =head1 SUBROUTINES/METHODS
596              
597             =head2 new
598              
599             Instantiate a new Hades::Macro::Dolos object.
600              
601             Hades::Macro::Dolos->new
602              
603             =head2 autoload_cb
604              
605             call autoload_cb method. Expects param $mg to be a Object, param $cb to be a Str.
606              
607             $obj->autoload_cb($mg, $cb)
608              
609             =head2 caller
610              
611             call caller method. Expects param $mg to be a Object, param $variable to be a Str.
612              
613             $obj->caller($mg, $variable)
614              
615             =head2 clear_unless_keys
616              
617             call clear_unless_keys method. Expects param $mg to be a Object, param $variable to be a Str, param $hash to be a Str.
618              
619             $obj->clear_unless_keys($mg, $variable, $hash)
620              
621             =head2 call_sub
622              
623             call call_sub method. Expects param $mg to be a Object, param $sub to be any value including undef, param @params to be any value including undef.
624              
625             $obj->call_sub($mg, $sub, @params)
626              
627             =head2 call_sub_my
628              
629             call call_sub_my method. Expects param $mg to be a Object, param $my to be a Str, param $sub to be any value including undef, param @params to be any value including undef.
630              
631             $obj->call_sub_my($mg, $my, $sub, @params)
632              
633             =head2 delete
634              
635             call delete method. Expects param $mg to be a Object, param $hash to be a Str, param $key to be a Str, param $variable to be a Optional[Str], param $or to be a Optional[Str], param $list to be a Optional[Bool].
636              
637             $obj->delete($mg, $hash, $key, $variable, $or, $list)
638              
639             =head2 die_unless_keys
640              
641             call die_unless_keys method. Expects param $mg to be a Object, param $hash to be a Str, param $error to be a Str.
642              
643             $obj->die_unless_keys($mg, $hash, $error)
644              
645             =head2 else
646              
647             call else method. Expects param $mg to be a Object, param @code to be any value including undef.
648              
649             $obj->else($mg, @code)
650              
651             =head2 elsif
652              
653             call elsif method. Expects param $mg to be a Object, param $condition to be a Str, param @code to be any value including undef.
654              
655             $obj->elsif($mg, $condition, @code)
656              
657             =head2 export
658              
659             call export method. Expects param $mg to be a Object, param $method to be a Str, param $code to be a Str, param $no_warnings to be a Int, param $caller to be a Str.
660              
661             $obj->export($mg, $method, $code, $no_warnings, $caller)
662              
663             =head2 for
664              
665             call for method. Expects param $mg to be a Object, param $condition to be a Str, param @code to be any value including undef.
666              
667             $obj->for($mg, $condition, @code)
668              
669             =head2 foreach
670              
671             call foreach method. Expects param $mg to be a Object, param $condition to be a Str, param @code to be any value including undef.
672              
673             $obj->foreach($mg, $condition, @code)
674              
675             =head2 for_keys
676              
677             call for_keys method. Expects param $mg to be a Object, param $hash to be a Str, param $key to be a Str, param @code to be any value including undef.
678              
679             $obj->for_keys($mg, $hash, $key, @code)
680              
681             =head2 for_key_exists_and_return
682              
683             call for_key_exists_and_return method. Expects param $mg to be a Object, param $hash to be a Str, param $for to be a Str.
684              
685             $obj->for_key_exists_and_return($mg, $hash, $for)
686              
687             =head2 grep
688              
689             call grep method. Expects param $mg to be a Object, param $condition to be a Str, param @code to be any value including undef.
690              
691             $obj->grep($mg, $condition, @code)
692              
693             =head2 grep_map
694              
695             call grep_map method. Expects param $mg to be a Object, param $condition to be a Str, param $grep_code to be a Str, param @map_code to be any value including undef.
696              
697             $obj->grep_map($mg, $condition, $grep_code, @map_code)
698              
699             =head2 if
700              
701             call if method. Expects param $mg to be a Object, param $condition to be a Str, param @code to be any value including undef.
702              
703             $obj->if($mg, $condition, @code)
704              
705             =head2 map
706              
707             call map method. Expects param $mg to be a Object, param $condition to be a Str, param @code to be any value including undef.
708              
709             $obj->map($mg, $condition, @code)
710              
711             =head2 map_grep
712              
713             call map_grep method. Expects param $mg to be a Object, param $condition to be a Str, param $grep_code to be a Str, param @map_code to be any value including undef.
714              
715             $obj->map_grep($mg, $condition, $grep_code, @map_code)
716              
717             =head2 maybe
718              
719             call maybe method. Expects param $mg to be a Object, param $key to be a Str, param $variable to be a Str.
720              
721             $obj->maybe($mg, $key, $variable)
722              
723             =head2 merge_hash_refs
724              
725             call merge_hash_refs method. Expects param $mg to be a Object, param @hashes to be any value including undef.
726              
727             $obj->merge_hash_refs($mg, @hashes)
728              
729             =head2 require
730              
731             call require method. Expects param $mg to be a Object, param $variable to be a Str.
732              
733             $obj->require($mg, $variable)
734              
735             =head2 unless
736              
737             call unless method. Expects param $mg to be a Object, param $condition to be a Str, param @code to be any value including undef.
738              
739             $obj->unless($mg, $condition, @code)
740              
741             =head2 while
742              
743             call while method. Expects param $mg to be a Object, param $condition to be a Str, param @code to be any value including undef.
744              
745             $obj->while($mg, $condition, @code)
746              
747             =head1 ACCESSORS
748              
749             =head2 macro
750              
751             get or set macro.
752              
753             $obj->macro;
754              
755             $obj->macro($value);
756              
757             =head1 AUTHOR
758              
759             LNATION, C<< <email at lnation.org> >>
760              
761             =head1 BUGS
762              
763             Please report any bugs or feature requests to C<bug-hades::macro::dolos at rt.cpan.org>, or through
764             the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Hades-Macro-Dolos>. I will be notified, and then you'll
765             automatically be notified of progress on your bug as I make changes.
766              
767             =head1 SUPPORT
768              
769             You can find documentation for this module with the perldoc command.
770              
771             perldoc Hades::Macro::Dolos
772              
773             You can also look for information at:
774              
775             =over 4
776              
777             =item * RT: CPAN's request tracker (report bugs here)
778              
779             L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Hades-Macro-Dolos>
780              
781             =item * AnnoCPAN: Annotated CPAN documentation
782              
783             L<http://annocpan.org/dist/Hades-Macro-Dolos>
784              
785             =item * CPAN Ratings
786              
787             L<https://cpanratings.perl.org/d/Hades-Macro-Dolos>
788              
789             =item * Search CPAN
790              
791             L<https://metacpan.org/release/Hades-Macro-Dolos>
792              
793             =back
794              
795             =head1 ACKNOWLEDGEMENTS
796              
797             =head1 LICENSE AND COPYRIGHT
798              
799             This software is Copyright (c) 2020 by LNATION.
800              
801             This is free software, licensed under:
802              
803             The Artistic License 2.0 (GPL Compatible)
804              
805             =cut
806              
807