| 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 |