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 13     13   5785 use strict;
  13         35  
  13         438  
6 13     13   78 use warnings FATAL => 'all';
  13         25  
  13         484  
7              
8 13     13   2411 use App::NDTools::INC;
  13         33  
  13         98  
9 13     13   1574 use App::NDTools::NDTool;
  13         31  
  13         462  
10 13     13   92 use App::NDTools::Util qw(chomp_evaled_error);
  13         32  
  13         836  
11 13     13   88 use Getopt::Long qw(GetOptionsFromArray :config bundling pass_through);
  13         28  
  13         105  
12 13     13   2336 use Log::Log4Cli;
  13         32  
  13         1277  
13 13     13   2647 use Storable qw(dclone);
  13         15390  
  13         832  
14 13     13   91 use Struct::Path 0.80 qw(path);
  13         300  
  13         746  
15 13     13   2026 use Struct::Path::PerlStyle 0.90 qw(str2path path2str);
  13         225643  
  13         15267  
16              
17 0     0 0 0 sub MODINFO { "n/a" }
18              
19             sub arg_opts {
20 118     118 0 239 my $self = shift;
21              
22             return (
23             'blame!' => \$self->{OPTS}->{blame}, # just to set opt in rule
24             'cond=s@' => \$self->{OPTS}->{cond},
25             'help|h' => sub {
26 7     7   5352 $self->{OPTS}->{help} = 1;
27 7         36 die "!FINISH";
28             },
29             'path=s@' => \$self->{OPTS}->{path},
30             'preserve=s@' => \$self->{OPTS}->{preserve},
31             'version|V' => sub {
32 7     7   5416 $self->{OPTS}->{version} = 1;
33 7         36 die "!FINISH";
34             },
35             )
36 118         2192 }
37              
38             sub check_rule {
39 0     0 0 0 return $_[0];
40             }
41              
42             sub configure {
43 85     85 0 145 return $_[0];
44             }
45              
46             sub defaults {
47             return {
48 225     225 0 1261 disabled => undef,
49             path => [],
50             };
51             }
52              
53             sub get_opts {
54 69     69 0 242 return $_[0]->{OPTS};
55             }
56              
57             *load_struct = \&App::NDTools::NDTool::load_struct;
58              
59             sub new {
60 225     225 0 56596 my $self = bless {}, shift;
61              
62 225         758 $self->{OPTS} = $self->defaults();
63 225         897 $self->configure;
64              
65 225         772 return $self;
66             }
67              
68             sub parse_args {
69 111     111 0 337 my ($self, $args) = @_;
70              
71 111 50       434 unless (GetOptionsFromArray ($args, $self->arg_opts)) {
72 0         0 $self->usage;
73 0         0 die_fatal "Unsupported opt passed", 1;
74             }
75              
76 111 100       47439 if ($self->{OPTS}->{help}) {
77 7         29 $self->usage;
78 7         114495 die_info, 0;
79             }
80              
81 104 100       370 if ($self->{OPTS}->{version}) {
82 7         309 print $self->VERSION . "\n";
83 7         64 die_info, 0;
84             }
85              
86 97 100       288 die_fatal $self->{ARG_ERROR}, 1 if (defined $self->{ARG_ERROR});
87              
88 92         378 $self->configure;
89              
90 90         441 return $self;
91             }
92              
93             sub process {
94 106     106 0 1882 my ($self, $data, $opts, $source) = @_;
95              
96 106 100       406 $self->check_rule($opts) or die_fatal undef, 1;
97              
98             $self->stash_preserved($data, $opts->{preserve})
99 100 100       422 if ($opts->{preserve});
100              
101 100         186 for my $path (@{$opts->{path}}) {
  100         288  
102 104 100       314 if (ref $path) { # complex paths passed to mod as is
103 27         103 $self->process_path($data, $path, undef, $opts, $source);
104             } else {
105 77     0   548 log_debug { "Processing path '$path'" };
  0         0  
106              
107 77         433 my $spath = eval { str2path($path) };
  77         376  
108 77 100       37988 die_fatal 'Failed to parse path ' . chomp_evaled_error($@), 4
109             if ($@);
110              
111 76         351 $self->process_path($data, $path, $spath, $opts, $source);
112             }
113             }
114              
115             $self->restore_preserved($data)
116 87 100       3840 if ($opts->{preserve});
117              
118 87         270 return $self;
119             }
120              
121             sub restore_preserved {
122 8     8 0 35 my ($self, $data) = @_;
123              
124 8         29 while (@{$self->{_preserved}}) {
  26         2439  
125 18         35 my ($path, $value) = splice @{$self->{_preserved}}, 0, 2;
  18         60  
126 18     0   127 log_debug { "Restoring preserved '" . path2str($path) . "'" };
  0         0  
127 18         83 path(${$data}, $path, assign => $value, expand => 1);
  18         91  
128             }
129              
130 8         55 return $self;
131             }
132              
133             sub stash_preserved {
134 8     8 0 27 my ($self, $data, $paths) = @_;
135              
136 8         24 for my $path (@{$paths}) {
  8         32  
137 8     0   79 log_debug { "Preserving '$path'" };
  0         0  
138 8         50 my $spath = eval { str2path($path) };
  8         37  
139 8 50       3216 die_fatal "Failed to parse path ($@)", 4 if ($@);
140 8         33 push @{$self->{_preserved}},
141 36 100       2200 map { $_ = ref $_ ? dclone($_) : $_ } # immutable now
142 8         28 path(${$data}, $spath, deref => 1, paths => 1);
  8         46  
143             }
144              
145 8         32 return $self;
146             }
147              
148             sub usage {
149 9     9 0 61 require Pod::Find;
150 9         626 require Pod::Usage;
151              
152 9         41832 Pod::Usage::pod2usage(
153             -exitval => 'NOEXIT',
154             -input => Pod::Find::pod_where({-inc => 1}, ref(shift)),
155             -output => \*STDERR,
156             -sections => 'NAME|DESCRIPTION|OPTIONS',
157             -verbose => 99
158             );
159             }
160              
161             1; # End of App::NDTools::NDProc::Module