Recurse on complex Perl data structure, applying needed rules

Question

Inspired by this answer and previous a commentator of code review use:

Given a complex Perl data structure, traverse/jigger/modify as follows:

• If ORACLE_SID is 'key' in any hash then keep only ORACLE_SID section matching of $ENV{ORACLE_SID}
• Eliminate any single level arrays, if after step 1, we're left with s_level arrays
• Enhance values of simple content values based on requirement

What else or better way can be done to achieve the intended goal?

# $reduce_1level is set by the caller of jigger()
our $reduce_1level = 1;
sub jigger
{
 our $cds; local *cds = \shift;
 my $type = ref $cds or return;
 if ($type eq 'HASH') {
 foreach my $key (keys %$cds) {
 if (ref $cds->{$key}) {
 $cds->{$key} = reduce_by_oracle_sid ($cds->{$key});
 delete $cds->{$key} if not defined $cds->{$key};
 jigger ($cds->{$key}) if ref $cds->{$key};
 }
 else {
 $cds->{$key} = enhance_value ($cds->{$key});
 }
 }
 }
 elsif ($type eq 'ARRAY')
 {
 @$cds = grep { $_ = reduce_by_oracle_sid($_); defined } @$cds;
 foreach my $elem (@$cds) {
 if (ref $elem) {
 jigger ($elem);
 }
 else {
 $elem = enhance_value ($elem);
 }
 }
 $cds = $cds->[0] if @$cds == 1 and $reduce_1level;
 }
}

I'm really only after jigger(). I'm listing the helper subs for the the same price.

sub reduce_by_oracle_sid
{
 my $node = shift;
 return $node unless ref $node eq 'HASH' and exists $node->{ORACLE_SID};
 return unless $node->{ORACLE_SID} =~ /$ENV{ORACLE_SID}/;
 delete $node->{ORACLE_SID};
 # If there was was just 'value' then we return only value...
 return exists $node->{value} ? $node->{value} : $node;
}
sub enhance_value
{
 my $v = shift;
 # Take out double //'s
 $v =~ s{//}{}g;
 # trim whitesapce
 $v =~ s/^\w*(\W*)\w*$/1ドル/;
 # inject SQL commands ...
 #
 # ... n more ...
 return $v;
}

• mpapec: Dumped input and output data structure would be helpful.

Answer 1

Is there an obvious reason why you don't use a cross-sectional Path tracer?

For instance, with Data::Dpath, seems like it could do what you want without too much fuss.

Your complicated example is quite trivial to extract nodes by ORACLE_ID at arbitrary depths.

use strict;
use warnings;
use Data::DPath qw( dpath );
use Data::Dump qw( pp );
$ENV{ORACLE_SID} = 6;
my $struct = {
 a => {
 b => {
 c => {
 x => {
 y => {
 name => "In Hash",
 ORACLE_SID => $ENV{ORACLE_SID}
 },
 z => {
 name => "Non Target",
 ORACLE_SID => 5,
 }
 },
 aa => [ { ORACLE_SID => $ENV{ORACLE_SID}, name => "In Array" } ], # just to make things interesting
 }
 },
 },
};
# find all nodes no matter how deep that have a child, which, themselves
# contains a hash with a key "ORACLE_SID"
my (@oracles) = dpath( '//ORACLE_SID[value eq ' . $ENV{ORACLE_SID} . ']/..' )->match($struct);
pp(@oracles);
#(
# { name => "In Hash", ORACLE_SID => 6 },
# { name => "In Array", ORACLE_SID => 6 },
#)

That at very least, makes the most of your logic extraneous, and the essentials of "what data are you querying" and "What are you doing with that data" become more clear to the code reader.