LanX has asked for the wisdom of the Perl Monks concerning the following question:

Dear monastery

In continuation of Proper Way to Reference a Hash Value

Let's say you have a deeply nested data structure, but you want only to display the subtrees where an item (hash key or hash value or array) in between passes a test (eq or regex or whatever)

Data::Printer has filters but they are normally used to format the current item.

I have an idea how to implement it nevertheless, but am quite busy right now. And next week I will certainly forget it.

Extra challenge: print the correct Perl path to access this element.

Anyone interested?

Alternative approaches?

Update

I was asked what "subtree" means. Those nested items which are not predecessor or successor are not displayed.

Update

This would be the subtree for finding the "field" key in the linked thread.

\ {
    content   { 
        errors     [
            [0] {
                field     "merge_fields", 
            }
        ], 
    },
}

[download]

the path would be ->{content}{errors}[0]{field}

Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

Replies are listed 'Best First'.
Re: Dump filtered subtree?
by tybalt89 (Monsignor) on Jan 28, 2020 at 15:33 UTC

    For a given key: 

    #!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11111952
use warnings;
use List::Util qw( none );
use Data::Dump qw( dd );

sub subtree
  {
  my ($key, $tree) = @_;
  if( ref $tree eq 'ARRAY' )
    {
    my @items = map [ subtree( $key, $_ ) ], @$tree;
    return +(none { $_->[0] } @items ) ? ( 0, []) :
      ( 1, [ map { $_->[0] ? $_->[1] : undef } @items ] );
    }
  elsif( ref $tree eq 'HASH' )
    {
    my @wanted;
    for my $k ( sort keys %$tree )
      {
      if( $k eq $key ) { push @wanted, [ 1, $k => $tree->{$k} ] }
      else
        {
        my ( $w, $t ) = subtree( $key, $tree->{$k} );
        $w and push @wanted, [ $w, $k => $t ];
        }
      }
    return @wanted > 0, +{ map { @{ $_ }[1, 2] } @wanted };
    }
  else { return 0, $tree }
  }

sub pathforkey
  {
  my ($key, $tree, $sofar) = @_;
  if( ref $tree eq 'HASH' )
    {
    return map {  
      $key eq $_ ? $sofar . "{$_}" : (),
      pathforkey( $key, $tree->{$_}, $sofar . "{$_}" )
      } sort keys %$tree;
    }
  elsif( ref $tree eq 'ARRAY' )
    {
    return map { pathforkey( $key, $tree->[$_], $sofar . "[$_]" )
      } 0 .. $#$tree;
    }
  else { return () }
  }

my $tree = gettree();
dd 'original tree', $tree;
print "\n";
my ($want, $subtree) = subtree( 'field', $tree );
dd "the subtree for 'field' ", $subtree;
print "\nall paths to key 'field' :\n";
print "$_\n" for pathforkey( 'field', $tree, '' );

sub gettree # slightly reduced...
  {
  my $tree = { 'cookies' => { '_AVESTA_ENVIRONMENT' => 'prod',
    '_mcid' => '1.340667ccb3eb6552450356561ab6bd92.' },
      'error' => '400 Bad Request',
      'content' => { 'detail' =>
      'The resource specific details, \'errors\' array.',
      'errors' => [ { 'message' => 'This value of type object.',
        'field' => 'merge_fields' } ],
      'status' => 400,
      'title' => 'Invalid Resource',
      'type' => 'http://developer.mailchimp.',
      'instance' => '59edf1fc-ed93-4a40-ba23-1f0af24a6eb3' },
      'code' => '400' };
  }

    [download]

    Outputs: 

    (
  "original tree",
  {
    code    => 400,
    content => {
                 detail   => "The resource specific details, 'errors' 
+array.",
                 errors   => [
                               { field => "merge_fields", message => "
+This value of type object." },
                             ],
                 instance => "59edf1fc-ed93-4a40-ba23-1f0af24a6eb3",
                 status   => 400,
                 title    => "Invalid Resource",
                 type     => "http://developer.mailchimp.",
               },
    cookies => {
                 _AVESTA_ENVIRONMENT => "prod",
                 _mcid => "1.340667ccb3eb6552450356561ab6bd92.",
               },
    error   => "400 Bad Request",
  },
)

(
  "the subtree for 'field' ",
  { content => { errors => [{ field => "merge_fields" }] } },
)

all paths to key 'field' :
{content}{errors}[0]{field}

    [download]
[reply]
[d/l]
[select]
      Yeah I thought about this, isolating the subtree and dumping it separately.

      Problem is that Data::Printer won't show the correct index numbers anymore.

      Besides, I didn't test it, but it didn't look like I could provide multiple keys.

      My intention is to have an interactive inspection tool ... And to understand Data::Printer better.

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

[reply]

        "it didn't look like I could provide multiple keys"

        Ask and you shall receive. Oh wait, you didn't ask, well no matter... 

        #!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11111952
use warnings;
use List::Util qw( none any );
use Data::Dump qw( dd );

sub subtree
  {
  my ($key, $tree) = @_;
  if( ref $tree eq 'ARRAY' )
    {
    my @items = map [ subtree( $key, $_ ) ], @$tree;
    return +(none { $_->[0] } @items ) ? ( 0, []) :
      ( 1, [ map { $_->[0] ? $_->[1] : undef } @items ] );
    }
  elsif( ref $tree eq 'HASH' )
    {
    my @wanted;
    for my $k ( sort keys %$tree )
      {
      if( matchkey( $key, $k ) ) { push @wanted, [ 1, $k => $tree->{$k
+} ] }
      else
        {
        my ( $w, $t ) = subtree( $key, $tree->{$k} );
        $w and push @wanted, [ $w, $k => $t ];
        }
      }
    return @wanted > 0, +{ map { @{ $_ }[1, 2] } @wanted };
    }
  else { return 0, $tree }
  }

sub matchkey
  {
  my ($key, $here) = @_;
  any { $_ eq $here } ref $key ? @$key : $key;
  }

sub pathforkey
  {
  my ($key, $tree, $sofar) = @_;
  if( ref $tree eq 'HASH' )
    {
    return map {  
      matchkey( $key, $_ ) ? $sofar . "{$_}" : (),
      pathforkey( $key, $tree->{$_}, $sofar . "{$_}" )
      } sort keys %$tree;
    }
  elsif( ref $tree eq 'ARRAY' )
    {
    return map { pathforkey( $key, $tree->[$_], $sofar . "[$_]" )
      } 0 .. $#$tree;
    }
  else { return () }
  }

my $tree = gettree();
dd 'original tree', $tree;
print "\n";
my ($want, $subtree) = subtree( [ 'field', '_mcid' ], $tree );
dd "the subtree for 'field' ", $subtree;
print "\nall paths to key 'field' :\n";
print "$_\n" for pathforkey( ['field', '_mcid'], $tree, '' );

sub gettree # slightly reduced...
  {
  my $tree = { 'cookies' => { '_AVESTA_ENVIRONMENT' => 'prod',
    '_mcid' => '1.340667ccb3eb6552450356561ab6bd92.' },
      'error' => '400 Bad Request',
      'content' => { 'detail' =>
      'The resource specific details, \'errors\' array.',
      'errors' => [ 'not this', { 'message' => 'This value of type obj
+ect.',
        'field' => 'merge_fields' } ],
      'status' => 400,
      'title' => 'Invalid Resource',
      'type' => 'http://developer.mailchimp.',
      'instance' => '59edf1fc-ed93-4a40-ba23-1f0af24a6eb3' },
      'code' => '400' };
  }

        [download]

        Outputs: 

        (
  "original tree",
  {
    code    => 400,
    content => {
                 detail   => "The resource specific details, 'errors' 
+array.",
                 errors   => [
                               "not this",
                               { field => "merge_fields", message => "
+This value of type object." },
                             ],
                 instance => "59edf1fc-ed93-4a40-ba23-1f0af24a6eb3",
                 status   => 400,
                 title    => "Invalid Resource",
                 type     => "http://developer.mailchimp.",
               },
    cookies => {
                 _AVESTA_ENVIRONMENT => "prod",
                 _mcid => "1.340667ccb3eb6552450356561ab6bd92.",
               },
    error   => "400 Bad Request",
  },
)

(
  "the subtree for 'field' ",
  {
    content => { errors => [undef, { field => "merge_fields" }] },
    cookies => { _mcid => "1.340667ccb3eb6552450356561ab6bd92." },
  },
)

all paths to key :
{content}{errors}[1]{field}
{cookies}{_mcid}

        [download]
[reply]
[d/l]
[select]

        "won't show the correct index numbers"

        Try it and see :)

[reply]
Re: Dump filtered subtree?
by Anonymous Monk on Jan 28, 2020 at 04:20 UTC
[reply]
      On a side note:

      I found many references and links for Data::Path but metacpan doesn't list it ...

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

[reply]

        This seems to be an indexing error in metacpan, or a specific choice made by metacpan, or a problem with the distribution.

        I thought it had maybe been deleted from CPAN, so using Google I searched for backpan data-path to find it on the Backpan. Google then showed me the link on the MetaCPAN site where it still lives.

        Maybe the cause is the META.yml file, or something else, as rt://55483 noted that problem 10 years ago already...

[reply]
[d/l]
      These are all good tools, some even extract the path.

      But I couldn't find an example of reducing a complex data structure to essential parts.

      Data::Printer is good in visualizing, I'm surprised that this is so hard.

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

[reply]

        These are all good tools, some even extract the path. But I couldn't find an example of reducing a complex data structure to essential parts. 

        find_rehohy( $VAR1 );
sub find_rehohy {
    my( $root ) = @_;
    my $my_cb = sub {
        my $val    = pp( $_[0] );
        my $path   = $_[1];
        my $depth  = $_[2];
        my @Paths  = @{ $_[3]||[] };
        my $depthpad = ( " " x $depth );
        my $varname = shift @Paths;
#     print "DiveVal( $varname, qw/ @{[ @Paths ]} /)\n$depthpad = $val
+; #d$depth\n\n";
        use Data::Diver qw/ DiveVal /;
        use Data::Printer;
        if( $Paths[-1] eq 'field' ){
            p( @Paths ); 
            my $reff = 'HASH' eq ref $root ? {} : [];
            DiveVal( $reff , @Paths ) =  $_[0];
            p $reff ;
            return;
        }
        return;
    };
    rehohy( $root,  0=> '$ref->' , $my_cb );
}
__END__
[
    [0] "content",
    [1] "errors",
    [2] 0,
    [3] "field"
]
\ {
    content   {
        errors   [
            [0] {
                field   "merge_fields"
            }
        ]
    }
}

        [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom