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   5770 use strict;
  13         32  
  13         443  
6 13     13   68 use warnings FATAL => 'all';
  13         37  
  13         467  
7              
8 13     13   1956 use App::NDTools::INC;
  13         31  
  13         94  
9 13     13   1555 use App::NDTools::NDTool;
  13         40  
  13         439  
10 13     13   74 use App::NDTools::Util qw(chomp_evaled_error);
  13         30  
  13         871  
11 13     13   87 use Getopt::Long qw(GetOptionsFromArray :config bundling pass_through);
  13         28  
  13         90  
12 13     13   2352 use Log::Log4Cli;
  13         29  
  13         1222  
13 13     13   2697 use Storable qw(dclone);
  13         16085  
  13         766  
14 13     13   87 use Struct::Path 0.80 qw(path);
  13         285  
  13         737  
15 13     13   2050 use Struct::Path::PerlStyle 0.80 qw(str2path path2str);
  13         228744  
  13         14670  
16              
17 0     0 0 0 sub MODINFO { "n/a" }
18              
19             sub arg_opts {
20 105     105 0 201 my $self = shift;
21              
22             return (
23             'blame!' => \$self->{OPTS}->{blame}, # just to set opt in rule
24             'help|h' => sub {
25 7     7   4909 $self->{OPTS}->{help} = 1;
26 7         30 die "!FINISH";
27             },
28             'path=s@' => \$self->{OPTS}->{path},
29             'preserve=s@' => \$self->{OPTS}->{preserve},
30             'version|V' => sub {
31 7     7   4990 $self->{OPTS}->{version} = 1;
32 7         31 die "!FINISH";
33             },
34             )
35 105         1468 }
36              
37             sub check_rule {
38 0     0 0 0 return $_[0];
39             }
40              
41             sub configure {
42 81     81 0 141 return $_[0];
43             }
44              
45             sub defaults {
46             return {
47 210     210 0 1142 disabled => undef,
48             path => [],
49             };
50             }
51              
52             sub get_opts {
53 64     64 0 222 return $_[0]->{OPTS};
54             }
55              
56             *load_struct = \&App::NDTools::NDTool::load_struct;
57              
58             sub new {
59 210     210 0 37130 my $self = bless {}, shift;
60              
61 210         642 $self->{OPTS} = $self->defaults();
62 210         767 $self->configure;
63              
64 210         661 return $self;
65             }
66              
67             sub parse_args {
68 105     105 0 314 my ($self, $args) = @_;
69              
70 105 50       376 unless (GetOptionsFromArray ($args, $self->arg_opts)) {
71 0         0 $self->usage;
72 0         0 die_fatal "Unsupported opt passed", 1;
73             }
74              
75 105 100       39985 if ($self->{OPTS}->{help}) {
76 7         34 $self->usage;
77 7         103017 die_info, 0;
78             }
79              
80 98 100       308 if ($self->{OPTS}->{version}) {
81 7         299 print $self->VERSION . "\n";
82 7         60 die_info, 0;
83             }
84              
85 91 100       263 die_fatal $self->{ARG_ERROR}, 1 if (defined $self->{ARG_ERROR});
86              
87 86         313 $self->configure;
88              
89 85         378 return $self;
90             }
91              
92             sub process {
93 104     104 0 1416 my ($self, $data, $opts, $source) = @_;
94              
95 104 100       328 $self->check_rule($opts) or die_fatal undef, 1;
96              
97             $self->stash_preserved($data, $opts->{preserve})
98 98 100       350 if ($opts->{preserve});
99              
100 98         171 for my $path (@{$opts->{path}}) {
  98         252  
101 102 100       251 if (ref $path) { # complex paths passed to mod as is
102 27         92 $self->process_path($data, $path, undef, $opts, $source);
103             } else {
104 75     0   470 log_debug { "Processing path '$path'" };
  0         0  
105              
106 75         374 my $spath = eval { str2path($path) };
  75         316  
107 75 100       35912 die_fatal 'Failed to parse path ' . chomp_evaled_error($@), 4
108             if ($@);
109              
110 74         310 $self->process_path($data, $path, $spath, $opts, $source);
111             }
112             }
113              
114             $self->restore_preserved($data)
115 85 100       3512 if ($opts->{preserve});
116              
117 85         246 return $self;
118             }
119              
120             sub restore_preserved {
121 8     8 0 49 my ($self, $data) = @_;
122              
123 8         32 while (@{$self->{_preserved}}) {
  26         2266  
124 18         50 my ($path, $value) = splice @{$self->{_preserved}}, 0, 2;
  18         65  
125 18     0   113 log_debug { "Restoring preserved '" . path2str($path) . "'" };
  0         0  
126 18         142 path(${$data}, $path, assign => $value, expand => 1);
  18         83  
127             }
128              
129 8         23 return $self;
130             }
131              
132             sub stash_preserved {
133 8     8 0 31 my ($self, $data, $paths) = @_;
134              
135 8         18 for my $path (@{$paths}) {
  8         31  
136 8     0   93 log_debug { "Preserving '$path'" };
  0         0  
137 8         53 my $spath = eval { str2path($path) };
  8         32  
138 8 50       3036 die_fatal "Failed to parse path ($@)", 4 if ($@);
139 8         31 push @{$self->{_preserved}},
140 36 100       2062 map { $_ = ref $_ ? dclone($_) : $_ } # immutable now
141 8         24 path(${$data}, $spath, deref => 1, paths => 1);
  8         41  
142             }
143              
144 8         24 return $self;
145             }
146              
147             sub usage {
148 7     7 0 43 require Pod::Find;
149 7         549 require Pod::Usage;
150              
151 7         39506 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