File Coverage

blib/lib/Hades/Realm/Import/Export.pm
Criterion Covered Total %
statement 47 51 92.1
branch 18 30 60.0
condition 10 14 71.4
subroutine 7 7 100.0
pod 4 4 100.0
total 86 106 81.1


line stmt bran cond sub pod time code
1             package Hades::Realm::Import::Export;
2 6     6   1833773 use strict;
  6         47  
  6         164  
3 6     6   29 use warnings;
  6         11  
  6         157  
4 6     6   31 use base qw/Hades::Realm::Exporter/;
  6         11  
  6         3106  
5             our $VERSION = 0.04;
6              
7             sub new {
8 9 100   9 1 9610 my ( $cls, %args ) = ( shift(), scalar @_ == 1 ? %{ $_[0] } : @_ );
  8         38  
9 9         54 my $self = $cls->SUPER::new(%args);
10 9         371 my %accessors = ();
11 9         21 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 9         38 return $self;
25             }
26              
27             sub build_new {
28 5     5 1 105315 my ( $orig, $self, @params ) = ( 'SUPER::build_new', @_ );
29              
30 5         33 my @res = $self->$orig( @params, q|%EX| );
31              
32 5 50       203 return wantarray ? @res : $res[0];
33             }
34              
35             sub build_exporter {
36 13     13 1 6402 my ( $self, $begin, $mg, $export, $meta ) = @_;
37 13 100 66     79 if ( !defined($begin) || ref $begin ) {
38 2 50       5 $begin = defined $begin ? $begin : 'undef';
39 2         18 die
40             qq{Str: invalid value $begin for variable \$begin in method build_exporter};
41             }
42 11 100 100     67 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
43 2 50       6 $mg = defined $mg ? $mg : 'undef';
44 2         17 die
45             qq{Object: invalid value $mg for variable \$mg in method build_exporter};
46             }
47 9 100 100     37 if ( ( ref($export) || "" ) ne "HASH" ) {
48 2 50       6 $export = defined $export ? $export : 'undef';
49 2         17 die
50             qq{HashRef: invalid value $export for variable \$export in method build_exporter};
51             }
52 7 100 100     34 if ( ( ref($meta) || "" ) ne "HASH" ) {
53 2 50       4 $meta = defined $meta ? $meta : 'undef';
54 2         17 die
55             qq{HashRef: invalid value $meta for variable \$meta in method build_exporter};
56             }
57              
58 5         9 my %ex = ();
59 5         11 for my $k ( keys %{$export} ) {
  5         15  
60 27         39 push @{ $ex{$_} }, $k for ( @{ $export->{$k} } );
  27         42  
  147         239  
61             }
62 5         23 my $ex_tags = Module::Generate::_stringify_struct( 'undefined', \%ex );
63 5         12332 $ex_tags =~ s/^{/(/;
64 5         31 $ex_tags =~ s/}$/);/;
65 5         54 $begin = '%EX = ' . $ex_tags . $begin;
66 5         41 return $begin;
67              
68             }
69              
70             sub after_class {
71 7     7 1 635 my ( $self, $mg ) = @_;
72 7 100 100     60 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
73 2 50       6 $mg = defined $mg ? $mg : 'undef';
74 2         18 die
75             qq{Object: invalid value $mg for variable \$mg in method after_class};
76             }
77              
78 5         25 $mg->base(q|Import::Export|);
79              
80             }
81              
82             1;
83              
84             __END__
85              
86             =head1 NAME
87              
88             Hades::Realm::Import::Export - Hades realm for Import::Export
89              
90             =head1 VERSION
91              
92             Version 0.01
93              
94             =cut
95              
96             =head1 SYNOPSIS
97              
98             Quick summary of what the module does:
99              
100             Hades->run({
101             eval => 'Kosmos {
102             [curae penthos] :t(Int) :d(2) :p :pr :c :r :i(1, GROUP)
103             geras $nosoi :t(Int) :d(5) :i { if (£penthos == $nosoi) { return £curae; } }
104             }',
105             realm => 'Import::Export',
106             });
107              
108             ... generates ...
109              
110             package Kosmos;
111             use strict;
112             use warnings;
113             use base qw/Import::Export/;
114             our $VERSION = 0.01;
115             our ( %EX, %ACCESSORS );
116              
117             BEGIN {
118             %EX = (
119             'curae' => [ 'EXPORT', 'EXPORT_OK', 'ACCESSORS', 'GROUP' ],
120             'clear_penthos' => [ 'EXPORT', 'EXPORT_OK', 'CLEARERS' ],
121             'penthos' => [ 'EXPORT', 'EXPORT_OK', 'ACCESSORS', 'GROUP' ],
122             'geras' => [ 'EXPORT_OK', 'METHODS' ],
123             'has_curae' => [ 'EXPORT', 'EXPORT_OK', 'PREDICATES' ],
124             'has_penthos' => [ 'EXPORT', 'EXPORT_OK', 'PREDICATES' ],
125             'clear_curae' => [ 'EXPORT', 'EXPORT_OK', 'CLEARERS' ]
126             );
127             %ACCESSORS = ( curae => 2, penthos => 2, );
128             }
129              
130             sub curae {
131             my ($value) = @_;
132             my $private_caller = caller();
133             if ( $private_caller ne __PACKAGE__ ) {
134             die "cannot call private method curae from $private_caller";
135             }
136             if ( defined $value ) {
137             if ( ref $value || $value !~ m/^[-+\d]\d*$/ ) {
138             die qq{Int: invalid value $value for accessor curae};
139             }
140             $ACCESSORS{curae} = $value;
141             }
142             return $ACCESSORS{curae};
143             }
144              
145             sub has_curae {
146             return exists $ACCESSORS{curae};
147             }
148              
149             sub clear_curae {
150             delete $ACCESSORS{curae};
151             return 1;
152             }
153              
154             sub penthos {
155             my ($value) = @_;
156             my $private_caller = caller();
157             if ( $private_caller ne __PACKAGE__ ) {
158             die "cannot call private method penthos from $private_caller";
159             }
160             if ( defined $value ) {
161             if ( ref $value || $value !~ m/^[-+\d]\d*$/ ) {
162             die qq{Int: invalid value $value for accessor penthos};
163             }
164             $ACCESSORS{penthos} = $value;
165             }
166             return $ACCESSORS{penthos};
167             }
168              
169             sub has_penthos {
170             return exists $ACCESSORS{penthos};
171             }
172              
173             sub clear_penthos {
174             delete $ACCESSORS{penthos};
175             return 1;
176             }
177              
178             sub geras {
179             my ($nosoi) = @_;
180             $nosoi = defined $nosoi ? $nosoi : 5;
181             if ( !defined($nosoi) || ref $nosoi || $nosoi !~ m/^[-+\d]\d*$/ ) {
182             $nosoi = defined $nosoi ? $nosoi : 'undef';
183             die
184             qq{Int: invalid value $nosoi for variable \$nosoi in method geras};
185             }
186             if ( penthos() == $nosoi ) { return curae(); }
187             }
188              
189             1;
190              
191             __END__
192              
193             =head1 SUBROUTINES/METHODS
194              
195             =head2 new
196              
197             Instantiate a new Hades::Realm::Import::Export object.
198              
199             Hades::Realm::Import::Export->new
200              
201             =head2 build_new
202              
203             call build_new method.
204              
205             =head2 build_exporter
206              
207             call build_exporter method. Expects param $begin to be a Str, param $mg to be a Object, param $export to be a HashRef, param $meta to be a HashRef.
208              
209             $obj->build_exporter($begin, $mg, $export, $meta)
210              
211             =head2 after_class
212              
213             call after_class method. Expects param $mg to be a Object.
214              
215             $obj->after_class($mg)
216              
217             =head1 AUTHOR
218              
219             LNATION, C<< <email at lnation.org> >>
220              
221             =head1 BUGS
222              
223             Please report any bugs or feature requests to C<bug-hades::realm::import::export at rt.cpan.org>, or through
224             the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Hades-Realm-Import-Export>. I will be notified, and then you'll
225             automatically be notified of progress on your bug as I make changes.
226              
227             =head1 SUPPORT
228              
229             You can find documentation for this module with the perldoc command.
230              
231             perldoc Hades::Realm::Import::Export
232              
233             You can also look for information at:
234              
235             =over 4
236              
237             =item * RT: CPAN's request tracker (report bugs here)
238              
239             L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Hades-Realm-Import-Export>
240              
241             =item * AnnoCPAN: Annotated CPAN documentation
242              
243             L<http://annocpan.org/dist/Hades-Realm-Import-Export>
244              
245             =item * CPAN Ratings
246              
247             L<https://cpanratings.perl.org/d/Hades-Realm-Import-Export>
248              
249             =item * Search CPAN
250              
251             L<https://metacpan.org/release/Hades-Realm-Import-Export>
252              
253             =back
254              
255             =head1 ACKNOWLEDGEMENTS
256              
257             =head1 LICENSE AND COPYRIGHT
258              
259             This software is Copyright (c) 2020 by LNATION.
260              
261             This is free software, licensed under:
262              
263             The Artistic License 2.0 (GPL Compatible)
264              
265             =cut
266              
267