Re: How to map a directory tree to a perl hash tree

[japhy]

I use the SNAP (Stacked Nodes Affect Parent) method. I use it for my YAPE modules. The process is rather simple. Make two variables refer to the same reference, and you create an array for stacking.

my $node = my $tree = [];
my @stack;

You never modify $tree directly -- you do all the manipulation on $node, and when you need to recurse, you add a new "field" to $node; then you push the $node onto the @stack, and then you set $node equal to the field:

if ($token eq '(') {
  push @{ $node }, [];
  push @stack, $node;
  $node = $node->[-1];  # the new empty array ref
}

When you return from the recursion, you get the top value from the @stack:

if ($token eq ')') {
  $node = pop @stack;
}

Now, $node contains what it was before, PLUS any modifications to that empty array reference. And because $node and $tree refer to the same data, modifying the data in $node modifies $tree.

It's important to realize that saying:

$a = $b = [];
$a = 2;

does not affect $b in any way. It's the changing of the data referred to by $a that affects $b.

Without further ado, here is my implementation of a directory tree structure, using SNAP.

#!/usr/bin/perl -w

use File::Find;
use Data::Dumper;
use strict;

$Data::Dumper::Indent = 1;

build_tree(my $tree, shift);
print Dumper $tree;


{ 
  sub build_tree {
    my $node = $_[0] = {};
    my @s;
    find( sub {
      # fixed 'if' => 'while' -- thanks Rudif
      $node = (pop @s)->[1] while @s and $File::Find::dir ne $s[-1][0]
+;
      return $node->{$_} = -s if -f;
      push @s, [ $File::Find::name, $node ];
      $node = $node->{$_} = {};
    }, $_[1]);
    $_[0]{$_[1]} = delete $_[0]{'.'};
  }
}

The recursion is not handled by me, it's handled by find(), so I had to kludge my way into faking the start and end of a recursion. But it works.

japhy -- Perl and Regex Hacker

[Rudif]

But it works.

Indeed, it works, it is free of evil string eval, and you explained it in English.
And I still have 0.5 * $weekend ahead of me, to let it sink in. Thanks!

Rudif

PS. Your OGRE is awesome. But it adds an extra  (?-imsx:) around the regex that I type in, e.g. I ask  ([\.\d]+) and it returns and explains  (?-imsx:([\.\d]+)) - why?

Update You qr // the submitted regex, right? Just guessing, I did not look into the source code.

[japhy]

I don't think so -- that would stop me from being able to point out the errors in a regex my own way.

I add the (?:...) around it for several reasons. First, to honor any of the /imsx switches you have on. Second, so that the regex has ONE root node (easier to parse). Third, so the regex is "its own regex". (That third reason is probably lame.)

japhy -- Perl and Regex Hacker

[Rudif]

But it works.

Er, almost :-(
There is a bug in sub build_tree.
To fix it, you have to replace the  if that pops the stack by a while .
The test below shows the difference.

Rudif



#! perl -w

use strict;
use File::Find;
use File::Path;
use Data::Dumper;
$Data::Dumper::Indent = 1;

my $dir = './buildtreetestdir';
mkpath "$dir";
mkpath "$dir/dir1";
mkpath "$dir/dir1/dir11";
mkpath "$dir/dir2";
mkpath "$dir/dir2/dir21";


build_tree(my $tree, $dir);

build_tree_fixed(my $tree_fixed, $dir);

print Data::Dumper->Dump( [ $tree, $tree_fixed ], [ qw / tree tree_fix
+ed / ] );

{ 
  sub build_tree {
    my $node = $_[0] = {};
    my @s;
    find( sub {
      $node = (pop @s)->[1] if @s and $File::Find::dir ne $s[-1][0];
      return $node->{$_} = -s if -f;
      push @s, [ $File::Find::name, $node ];
      $node = $node->{$_} = {};
    }, $_[1]);
    $_[0]{$_[1]} = delete $_[0]{'.'};
  }
}

{ 
  sub build_tree_fixed {
    my $node = $_[0] = {};
    my @s;
    find( sub {
      $node = (pop @s)->[1] while @s and $File::Find::dir ne $s[-1][0]
+;
      return $node->{$_} = -s if -f;
      push @s, [ $File::Find::name, $node ];
      $node = $node->{$_} = {};
    }, $_[1]);
    $_[0]{$_[1]} = delete $_[0]{'.'};
  }
}

__END__

$tree = {
  './buildtreetestdir' => {
    'dir2' => {
      'dir21' => {},
      'dir1' => {
        'dir11' => {}
      }
    }
  }
};
$tree_fixed = {
  './buildtreetestdir' => {
    'dir1' => {
      'dir11' => {}
    },
    'dir2' => {
      'dir21' => {}
    }
  }
};

[japhy]

Sorry. Thanks for the fix. I think I actually fixed it like that after I posted the code, but forgot to fix it here.

japhy -- Perl and Regex Hacker