File Coverage

blib/lib/Hades/Macro/FH.pm
Criterion Covered Total %
statement 100 104 96.1
branch 80 110 72.7
condition 40 60 66.6
subroutine 10 10 100.0
pod 7 7 100.0
total 237 291 81.4


line stmt bran cond sub pod time code
1             package Hades::Macro::FH;
2 2     2   71086 use strict;
  2         13  
  2         68  
3 2     2   11 use warnings;
  2         6  
  2         70  
4 2     2   12 use base qw/Hades::Macro/;
  2         5  
  2         1079  
5             our $VERSION = 0.19;
6              
7             sub new {
8 14 100   14 1 19674 my ( $cls, %args ) = ( shift(), scalar @_ == 1 ? %{ $_[0] } : @_ );
  11         36  
9 14         60 my $self = $cls->SUPER::new(%args);
10 12         46 my %accessors = (
11             macro => {
12             default =>
13             [qw/open_write open_read close_file read_file write_file/],
14             },
15             );
16 12         28 for my $accessor ( keys %accessors ) {
17             my $param
18             = defined $args{$accessor}
19             ? $args{$accessor}
20 12 100       29 : $accessors{$accessor}->{default};
21             my $value
22             = $self->$accessor( $accessors{$accessor}->{builder}
23 12 50       40 ? $accessors{$accessor}->{builder}->( $self, $param )
24             : $param );
25 12 50 33     49 unless ( !$accessors{$accessor}->{required} || defined $value ) {
26 0         0 die "$accessor accessor is required";
27             }
28             }
29 12         81 return $self;
30             }
31              
32             sub macro {
33 32     32 1 1316 my ( $self, $value ) = @_;
34 32 100       67 if ( defined $value ) {
35 29 100 100     85 if ( ( ref($value) || "" ) ne "ARRAY" ) {
36 4         37 die qq{ArrayRef: invalid value $value for accessor macro};
37             }
38 25         47 $self->{macro} = $value;
39             }
40 28         65 return $self->{macro};
41             }
42              
43             sub open_write {
44 8     8 1 4438 my ( $self, $mg, $file, $variable, $error ) = @_;
45 8 100 100     59 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
46 2 50       7 $mg = defined $mg ? $mg : 'undef';
47 2         19 die
48             qq{Object: invalid value $mg for variable \$mg in method open_write};
49             }
50 6 100 66     29 if ( !defined($file) || ref $file ) {
51 2 50       7 $file = defined $file ? $file : 'undef';
52 2         19 die
53             qq{Str: invalid value $file for variable \$file in method open_write};
54             }
55 4 50       10 $variable = defined $variable ? $variable : "\$fh";
56 4 100 66     18 if ( !defined($variable) || ref $variable ) {
57 2 50       4 $variable = defined $variable ? $variable : 'undef';
58 2         19 die
59             qq{Str: invalid value $variable for variable \$variable in method open_write};
60             }
61 2 50       8 $error = defined $error ? $error : "cannot open file for writing";
62 2 50 33     10 if ( !defined($error) || ref $error ) {
63 2 50       5 $error = defined $error ? $error : 'undef';
64 2         19 die
65             qq{Str: invalid value $error for variable \$error in method open_write};
66             }
67              
68 0         0 return qq|open my $variable, ">", $file or die "$error: \$!";|;
69              
70             }
71              
72             sub open_read {
73 8     8 1 4375 my ( $self, $mg, $file, $variable, $error ) = @_;
74 8 100 100     60 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
75 2 50       7 $mg = defined $mg ? $mg : 'undef';
76 2         20 die
77             qq{Object: invalid value $mg for variable \$mg in method open_read};
78             }
79 6 100 66     30 if ( !defined($file) || ref $file ) {
80 2 50       6 $file = defined $file ? $file : 'undef';
81 2         19 die
82             qq{Str: invalid value $file for variable \$file in method open_read};
83             }
84 4 50       8 $variable = defined $variable ? $variable : "\$fh";
85 4 100 66     19 if ( !defined($variable) || ref $variable ) {
86 2 50       7 $variable = defined $variable ? $variable : 'undef';
87 2         19 die
88             qq{Str: invalid value $variable for variable \$variable in method open_read};
89             }
90 2 50       6 $error = defined $error ? $error : "cannot open file for reading";
91 2 50 33     14 if ( !defined($error) || ref $error ) {
92 2 50       6 $error = defined $error ? $error : 'undef';
93 2         18 die
94             qq{Str: invalid value $error for variable \$error in method open_read};
95             }
96              
97 0         0 return qq|open my $variable, "<", $file or die "$error: \$!";|;
98              
99             }
100              
101             sub close_file {
102 6     6 1 3124 my ( $self, $mg, $file, $variable ) = @_;
103 6 100 100     45 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
104 2 50       8 $mg = defined $mg ? $mg : 'undef';
105 2         19 die
106             qq{Object: invalid value $mg for variable \$mg in method close_file};
107             }
108 4 100 66     21 if ( !defined($file) || ref $file ) {
109 2 50       6 $file = defined $file ? $file : 'undef';
110 2         21 die
111             qq{Str: invalid value $file for variable \$file in method close_file};
112             }
113 2 50       8 $variable = defined $variable ? $variable : "\$fh";
114 2 50 33     11 if ( !defined($variable) || ref $variable ) {
115 2 50       5 $variable = defined $variable ? $variable : 'undef';
116 2         21 die
117             qq{Str: invalid value $variable for variable \$variable in method close_file};
118             }
119              
120 0         0 return qq|close $variable|;
121              
122             }
123              
124             sub read_file {
125 9     9 1 4413 my ( $self, $mg, $file, $variable, $error ) = @_;
126 9 100 100     70 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
127 2 50       6 $mg = defined $mg ? $mg : 'undef';
128 2         19 die
129             qq{Object: invalid value $mg for variable \$mg in method read_file};
130             }
131 7 100 66     40 if ( !defined($file) || ref $file ) {
132 2 50       6 $file = defined $file ? $file : 'undef';
133 2         18 die
134             qq{Str: invalid value $file for variable \$file in method read_file};
135             }
136 5 100       15 $variable = defined $variable ? $variable : "\$fh";
137 5 100 66     24 if ( !defined($variable) || ref $variable ) {
138 2 50       5 $variable = defined $variable ? $variable : 'undef';
139 2         18 die
140             qq{Str: invalid value $variable for variable \$variable in method read_file};
141             }
142 3 100       10 $error = defined $error ? $error : "cannot open file for reading";
143 3 100 66     16 if ( !defined($error) || ref $error ) {
144 2 50       5 $error = defined $error ? $error : 'undef';
145 2         19 die
146             qq{Str: invalid value $error for variable \$error in method read_file};
147             }
148              
149             return
150 1         9 qq|open my $variable, "<", $file or die "$error: \$!";|
151             . qq|my \$content = do { local \$/; <$variable> };|
152             . qq|close $variable;|;
153              
154             }
155              
156             sub write_file {
157 11     11 1 5630 my ( $self, $mg, $file, $content, $variable, $error ) = @_;
158 11 100 100     148 if ( ( ref($mg) || "" ) =~ m/^(|HASH|ARRAY|SCALAR|CODE|GLOB)$/ ) {
159 2 50       7 $mg = defined $mg ? $mg : 'undef';
160 2         20 die
161             qq{Object: invalid value $mg for variable \$mg in method write_file};
162             }
163 9 100 66     46 if ( !defined($file) || ref $file ) {
164 2 50       7 $file = defined $file ? $file : 'undef';
165 2         18 die
166             qq{Str: invalid value $file for variable \$file in method write_file};
167             }
168 7 100 66     30 if ( !defined($content) || ref $content ) {
169 2 50       6 $content = defined $content ? $content : 'undef';
170 2         20 die
171             qq{Str: invalid value $content for variable \$content in method write_file};
172             }
173 5 100       19 $variable = defined $variable ? $variable : "\$wh";
174 5 100 66     24 if ( !defined($variable) || ref $variable ) {
175 2 50       5 $variable = defined $variable ? $variable : 'undef';
176 2         19 die
177             qq{Str: invalid value $variable for variable \$variable in method write_file};
178             }
179 3 100       12 $error = defined $error ? $error : "cannot open file for writing";
180 3 100 66     15 if ( !defined($error) || ref $error ) {
181 2 50       4 $error = defined $error ? $error : 'undef';
182 2         19 die
183             qq{Str: invalid value $error for variable \$error in method write_file};
184             }
185              
186             return
187 1         8 qq|open my $variable, ">", $file or die "$error: \$!";|
188             . qq|print $variable $content;|
189             . qq|close $variable;|;
190              
191             }
192              
193             1;
194              
195             __END__
196              
197             =head1 NAME
198              
199             Hades::Macro::FH - Hades macro helpers for FH
200              
201             =head1 VERSION
202              
203             Version 0.01
204              
205             =cut
206              
207             =head1 SYNOPSIS
208              
209             Quick summary of what the module does:
210              
211             Hades->run({
212             eval => q|
213             macro {
214             FH [ alias => { read_file => [qw/rf/], write_file => [qw/wf/] } ]
215             }
216             Kosmos {
217             geras $file :t(Str) :d('path/to/file.txt') {
218             €rf($file);
219             $content = 'limos';
220             €wf($file, $content);
221             }
222             }
223             |;
224             });
225              
226             ... generates ...
227              
228             package Kosmos;
229             use strict;
230             use warnings;
231             our $VERSION = 0.01;
232              
233             sub new {
234             my ( $cls, %args ) = ( shift(), scalar @_ == 1 ? %{ $_[0] } : @_ );
235             my $self = bless {}, $cls;
236             my %accessors = ();
237             for my $accessor ( keys %accessors ) {
238             my $value
239             = $self->$accessor(
240             defined $args{$accessor}
241             ? $args{$accessor}
242             : $accessors{$accessor}->{default} );
243             unless ( !$accessors{$accessor}->{required} || defined $value ) {
244             die "$accessor accessor is required";
245             }
246             }
247             return $self;
248             }
249              
250             sub geras {
251             my ( $self, $file ) = @_;
252             $file = defined $file ? $file : 'path/to/file.txt';
253             if ( !defined($file) || ref $file ) {
254             $file = defined $file ? $file : 'undef';
255             die qq{Str: invalid value $file for variable \$file in method geras};
256             }
257              
258             open my $fh, "<", $file or die "cannot open file for reading: $!";
259             my $content = do { local $/; <$fh> };
260             close $fh;
261             $content = 'limos';
262             open my $wh, ">", $file or die "cannot open file for writing: $!";
263             print $wh $content;
264             close $wh;
265              
266             }
267              
268             1;
269              
270             __END__
271              
272             =head1 SUBROUTINES/METHODS
273              
274             =head2 new
275              
276             Instantiate a new Hades::Macro::FH object.
277              
278             Hades::Macro::FH->new
279              
280             =head2 open_write
281              
282             call open_write method. Expects param $mg to be a Object, param $file to be a Str, param $variable to be a Str, param $error to be a Str.
283              
284             $obj->open_write($mg, $file, $variable, $error)
285              
286             =head2 open_read
287              
288             call open_read method. Expects param $mg to be a Object, param $file to be a Str, param $variable to be a Str, param $error to be a Str.
289              
290             $obj->open_read($mg, $file, $variable, $error)
291              
292             =head2 close_file
293              
294             call close_file method. Expects param $mg to be a Object, param $file to be a Str, param $variable to be a Str.
295              
296             $obj->close_file($mg, $file, $variable)
297              
298             =head2 read_file
299              
300             call read_file method. Expects param $mg to be a Object, param $file to be a Str, param $variable to be a Str, param $error to be a Str.
301              
302             $obj->read_file($mg, $file, $variable, $error)
303              
304             =head2 write_file
305              
306             call write_file method. Expects param $mg to be a Object, param $file to be a Str, param $content to be a Str, param $variable to be a Str, param $error to be a Str.
307              
308             $obj->write_file($mg, $file, $content, $variable, $error)
309              
310             =head1 ACCESSORS
311              
312             =head2 macro
313              
314             get or set macro.
315              
316             $obj->macro;
317              
318             $obj->macro($value);
319              
320             =head1 AUTHOR
321              
322             LNATION, C<< <email at lnation.org> >>
323              
324             =head1 BUGS
325              
326             Please report any bugs or feature requests to C<bug-hades::macro::fh at rt.cpan.org>, or through
327             the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Hades-Macro-FH>. I will be notified, and then you'll
328             automatically be notified of progress on your bug as I make changes.
329              
330             =head1 SUPPORT
331              
332             You can find documentation for this module with the perldoc command.
333              
334             perldoc Hades::Macro::FH
335              
336             You can also look for information at:
337              
338             =over 4
339              
340             =item * RT: CPAN's request tracker (report bugs here)
341              
342             L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Hades-Macro-FH>
343              
344             =item * AnnoCPAN: Annotated CPAN documentation
345              
346             L<http://annocpan.org/dist/Hades-Macro-FH>
347              
348             =item * CPAN Ratings
349              
350             L<https://cpanratings.perl.org/d/Hades-Macro-FH>
351              
352             =item * Search CPAN
353              
354             L<https://metacpan.org/release/Hades-Macro-FH>
355              
356             =back
357              
358             =head1 ACKNOWLEDGEMENTS
359              
360             =head1 LICENSE AND COPYRIGHT
361              
362             This software is Copyright (c) 2020 by LNATION.
363              
364             This is free software, licensed under:
365              
366             The Artistic License 2.0 (GPL Compatible)
367              
368             =cut
369              
370