List of paths into hash array tree in Perl - perl

Question

I got an array of paths
C:\A
C:\B\C
D:\AB
and I'd like to have these in a hash array tree so I can go through them in a TT2 template.
What I mean is like this:
#dirs = [
{
name => "C:",
subs => [
{
name => "A",
subs => [],
},
{
name => "B",
subs => [
{
name => "C",
subs => [],
}
],
}
]
},
{
name => "D:",
subs => [
{
name => "AB",
subs => [],
}
],
}
]
I also know that I'm probably doing brainderp here so I'm open to other approaches, only requirement is turning that list of paths into something you can rebuild as a tree with the TT2 Template Toolkit.
Also what's that structure called? I just thought of hash array tree but I bet that's wrong.

Answer 1

Here's a very short approach. Note that this can only be so simple because I changed your data format to a hash of hashes which perfectly matches your tree structure. See the code below to transform the resulting structure to yours.
my $tree = {root => {}};
foreach my $input (<DATA>) { chomp $input;
my $t = $tree;
$t = $t->{$_} //= {} for split /\\/ => $input;
}
use Data::Dumper; print Dumper $tree;
__DATA__
C:\A
C:\B\C
D:\AB
C:\B\A
C:\B\A\C
Output:
$VAR1 = {
'C:' => {
'A' => {},
'B' => {
'A' => {
'C' => {}
},
'C' => {}
}
},
'D:' => {
'AB' => {}
}
};
To transform this data structure into yours, simply use this code:
sub transform {
my $tree = shift;
my #children = ();
while (my ($name, $children) = each %$tree) {
push #children, {
name => $name,
subs => [ transform($children) ],
}
}
return #children;
}
my $AoH_tree = {name => 'root', subs => [transform($tree)] };
Done. :) For a completely different approach with much more sugar, power and readability, but much more LOC, see my other answer.

Answer 2

This is a longer but much more readable and more comfortable solution. You don't have to (and probably don't want to) use this, but maybe it can help (not only you) to learn more about different approaches. It introduces a small Moo class for tree nodes which can add names recursively to itself with readable sorting and stringification methods.
Edit: for a completely different and extremely short alternative, see my other answer. I divided it up in two answers because they are completely different approaches and because this answer is already long enough. ;)
Tree class
Note this is basically no more than your nested AoHoAoH... structure - with a litte bit sugar added. ;)
# define a tree structure
package Tree;
use Moo; # activates strict && warnings
use List::Util 'first';
# name of this node
has name => (is => 'ro');
# array ref of children
has subs => (is => 'rw', isa => sub { die unless ref shift eq 'ARRAY' });
Now after the basic preparations (our objects have one scalar name and one array ref subs) we come to the main part of this answer: the recursive add_deeply method. Note that from here everything reflects the recursive nature of your data structure:
# recursively add to this tree
sub add_deeply {
my ($self, #names) = #_;
my $next_name = shift #names;
# names empty: do nothing
return unless defined $next_name;
# find or create a matching tree
my $subtree = first {$_->name eq $next_name} #{$self->subs};
push #{$self->subs}, $subtree = Tree->new(name => $next_name, subs => [])
unless defined $subtree;
# recurse
$subtree->add_deeply(#names);
}
The following two methods are not that important. Basically they are here to make the output pretty:
# sort using node names
sub sort {
my $self = shift;
$_->sort for #{$self->subs}; # sort my children
$self->subs([ sort {$a->name cmp $b->name} #{$self->subs} ]); # sort me
}
# stringification
use overload '""' => \&to_string;
sub to_string {
my $self = shift;
my $prefix = shift // '';
# prepare
my $str = $prefix . '{TREE name: "' . $self->name . '"';
# stringify children
if (#{$self->subs}) {
$str .= ", children: [\n";
$str .= $_->to_string(" $prefix") for #{$self->subs};
$str .= "$prefix]";
}
# done
return $str . "}\n";
}
How to use this
Now comes the simple part. Just read the input (from __DATA__ here) and add_deeply:
# done with the tree structure: now use it
package main;
# parse and add names to a tree
my $tree = Tree->new(name => 'root', subs => []);
foreach my $line (<DATA>) {
chomp $line;
$tree->add_deeply(split /\\/ => $line);
}
# output
$tree->sort;
print $tree;
__DATA__
C:\A
C:\B\C
D:\AB
C:\B\A
C:\B\A\C
Output:
{TREE name: "root", children: [
{TREE name: "C:", children: [
{TREE name: "A"}
{TREE name: "B", children: [
{TREE name: "A", children: [
{TREE name: "C"}
]}
{TREE name: "C"}
]}
]}
{TREE name: "D:", children: [
{TREE name: "AB"}
]}
]}

Answer 3

I did one with a complex hash structure keeping track of already placed nodes, and then I did this one. More steps, but somewhat leaner code.
while ( <> ) {
chomp;
my $ref = \#dirs;
foreach my $dir ( split /\\/ ) {
my $i = 0;
$i++ while ( $ref->[$i] and $ref->[$i]{name} ne $dir );
my $r = $ref->[$i] ||= { name => $dir, subs => [] };
$ref = $r->{subs};
}
}