File Coverage

blib/lib/App/NDTools/NDProc/Module.pm
Criterion Covered Total %
statement 92 99 92.9
branch 20 22 90.9
condition n/a
subroutine 22 27 81.4
pod 0 12 0.0
total 134 160 83.7


line stmt bran cond sub pod time code
1             package App::NDTools::NDProc::Module;
2              
3             # base class for ndproc modules
4              
5 10     10   3890 use strict;
  10         20  
  10         300  
6 10     10   48 use warnings FATAL => 'all';
  10         15  
  10         300  
7              
8 10     10   1359 use App::NDTools::INC;
  10         17  
  10         61  
9 10     10   1420 use App::NDTools::NDTool;
  10         23  
  10         301  
10 10     10   56 use App::NDTools::Util qw(chomp_evaled_error);
  10         19  
  10         497  
11 10     10   51 use Getopt::Long qw(GetOptionsFromArray :config bundling pass_through);
  10         20  
  10         57  
12 10     10   1488 use Log::Log4Cli;
  10         17  
  10         801  
13 10     10   2303 use Storable qw(dclone);
  10         13328  
  10         525  
14 10     10   59 use Struct::Path 0.80 qw(path);
  10         183  
  10         432  
15 10     10   1656 use Struct::Path::PerlStyle 0.80 qw(str2path path2str);
  10         190150  
  10         9849  
16              
17 0     0 0 0 sub MODINFO { "n/a" }
18              
19             sub arg_opts {
20 76     76 0 126 my $self = shift;
21              
22             return (
23             'blame!' => \$self->{OPTS}->{blame}, # just to set opt in rule
24             'help|h' => sub {
25 4     4   2383 $self->{OPTS}->{help} = 1;
26 4         15 die "!FINISH";
27             },
28             'path=s@' => \$self->{OPTS}->{path},
29             'preserve=s@' => \$self->{OPTS}->{preserve},
30             'version|V' => sub {
31 4     4   2442 $self->{OPTS}->{version} = 1;
32 4         16 die "!FINISH";
33             },
34             )
35 76         1061 }
36              
37             sub check_rule {
38 0     0 0 0 return $_[0];
39             }
40              
41             sub configure {
42 81     81 0 116 return $_[0];
43             }
44              
45             sub defaults {
46             return {
47 161     161 0 886 disabled => undef,
48             path => [],
49             };
50             }
51              
52             sub get_opts {
53 41     41 0 160 return $_[0]->{OPTS};
54             }
55              
56             *load_struct = \&App::NDTools::NDTool::load_struct;
57              
58             sub new {
59 161     161 0 18755 my $self = bless {}, shift;
60              
61 161         443 $self->{OPTS} = $self->defaults();
62 161         537 $self->configure;
63              
64 161         415 return $self;
65             }
66              
67             sub parse_args {
68 76     76 0 182 my ($self, $args) = @_;
69              
70 76 50       212 unless (GetOptionsFromArray ($args, $self->arg_opts)) {
71 0         0 $self->usage;
72 0         0 die_fatal "Unsupported opt passed", 1;
73             }
74              
75 76 100       20374 if ($self->{OPTS}->{help}) {
76 4         14 $self->usage;
77 4         53715 die_info, 0;
78             }
79              
80 72 100       199 if ($self->{OPTS}->{version}) {
81 4         146 print $self->VERSION . "\n";
82 4         30 die_info, 0;
83             }
84              
85 68 100       151 die_fatal $self->{ARG_ERROR}, 1 if (defined $self->{ARG_ERROR});
86              
87 63         190 $self->configure;
88              
89 62         192 return $self;
90             }
91              
92             sub process {
93 84     84 0 1164 my ($self, $data, $opts, $source) = @_;
94              
95 84 100       278 $self->check_rule($opts) or die_fatal undef, 1;
96              
97             $self->stash_preserved($data, $opts->{preserve})
98 81 100       236 if ($opts->{preserve});
99              
100 81         115 for my $path (@{$opts->{path}}) {
  81         175  
101 85 100       173 if (ref $path) { # complex paths passed to mod as is
102 27         74 $self->process_path($data, $path, undef, $opts, $source);
103             } else {
104 58     0   322 log_debug { "Processing path '$path'" };
  0         0  
105              
106 58         254 my $spath = eval { str2path($path) };
  58         218  
107 58 100       26106 die_fatal 'Failed to parse path ' . chomp_evaled_error($@), 4
108             if ($@);
109              
110 57         200 $self->process_path($data, $path, $spath, $opts, $source);
111             }
112             }
113              
114             $self->restore_preserved($data)
115 73 100       2683 if ($opts->{preserve});
116              
117 73         185 return $self;
118             }
119              
120             sub restore_preserved {
121 5     5 0 30 my ($self, $data) = @_;
122              
123 5         22 while (@{$self->{_preserved}}) {
  20         1740  
124 15         30 my ($path, $value) = splice @{$self->{_preserved}}, 0, 2;
  15         92  
125 15     0   94 log_debug { "Restoring preserved '" . path2str($path) . "'" };
  0         0  
126 15         54 path(${$data}, $path, assign => $value, expand => 1);
  15         63  
127             }
128              
129 5         37 return $self;
130             }
131              
132             sub stash_preserved {
133 5     5 0 15 my ($self, $data, $paths) = @_;
134              
135 5         14 for my $path (@{$paths}) {
  5         14  
136 5     0   64 log_debug { "Preserving '$path'" };
  0         0  
137 5         31 my $spath = eval { str2path($path) };
  5         20  
138 5 50       2042 die_fatal "Failed to parse path ($@)", 4 if ($@);
139 5         21 push @{$self->{_preserved}},
140 30 100       1339 map { $_ = ref $_ ? dclone($_) : $_ } # immutable now
141 5         13 path(${$data}, $spath, deref => 1, paths => 1);
  5         26  
142             }
143              
144 5         13 return $self;
145             }
146              
147             sub usage {
148 4     4 0 22 require Pod::Find;
149 4         484 require Pod::Usage;
150              
151 4         32737 Pod::Usage::pod2usage(
152             -exitval => 'NOEXIT',
153             -input => Pod::Find::pod_where({-inc => 1}, ref(shift)),
154             -output => \*STDERR,
155             -sections => 'NAME|DESCRIPTION|OPTIONS',
156             -verbose => 99
157             );
158             }
159              
160             1; # End of App::NDTools::NDProc::Module