Create directory tree in Perl that would comply with Fancytree expected JSON format

Question

How to create directory tree in Perl to comply with Fancytree expected JSON format?

This is the Perl part I came up with, that traverses through given path:

sub get_tree
{
    my ($gpath) = @_;
    my %r;

    use File::Find;
    my $c = sub {
        my $dir  = $File::Find::dir;
        my $r    = \%r;

        my $tdir = $dir;
        $tdir    =~ s|^\Q$gpath\E/?||;

        $r = $r->{$_} ||= {} for split m|/|, $tdir;
    };
    find($c, $gpath);
    return \%r;
}

It returns the following result after JSON encode:

 {
  "dir3":{

  },
  "dir1":{
    "sub-dir2":{

    },
    "sub-dir1":{

    }
  },
  "dir2":{
    "sub-dir1":{
      "sub-sub-dir1":{
        "sub-sub-sub-dir1":{

        }
      }
    }
  }
}

The expected result for Fancytree to comply with its JSON format is:

[
    {"parent": "dir3"},
    {"parent": "dir2", "child": [
       {"parent": "sub-dir1", "child": [
          {"parent": "sub-sub-dir1", "child": [
             {"parent": "sub-sub-sub-dir1"}
          ]}
       ]}
    ]},
    {"parent": "dir1", "child": [
       {"parent": "sub-dir1"},
       {"parent": "sub-dir1"}
    ]}
]

The point is to do it in a single run, without post processing, which would be ideal.

Any help of how to achieve that?

Answer 1

You can try,

use strict;
use warnings;
use Data::Dumper;

sub get_tree {
    my ($gpath) = @_;
    my %r;
    my @root;

    use File::Find;
    my $cb = sub {

        my $tdir = $File::Find::dir;
        $tdir    =~ s|^\Q$gpath\E/?||;
        return if $r{$tdir} or !$tdir;

        my ($pdir, $cdir) = $tdir =~ m|^ (.+) / ([^/]+) \z|x;
        my $c = $r{$tdir} = { parent => $cdir // $tdir };

        if (defined $pdir) { push @{ $r{$pdir}{child} }, $c }
        else { push @root, $c }

    };
    find($cb, $gpath);
    return \@root;
}

It uses hash for fast lookup of nodes, and complete directory structure is built atop of @root.

Answer 2

Using recursion instead of File::Find, using Path::Tiny to handle paths:

#!/usr/bin/perl
use warnings;
use strict;

use Path::Tiny;
sub get_tree {
    my ($struct, $root, @path) = @_;
    for my $child (path($root, @path)->children) {
        if (-d $child) {
            my $base = $child->basename;
            push @$struct, { parent => $base };
            my $recurse = get_tree($struct->[-1]{child} = [],
                                   $root, @path, $base);
            delete $struct->[-1]{child} unless @$recurse;
        }
    }
    return $struct
}

use Test::More tests => 1;
use Test::Deep;

my $expected = bag({parent => 'dir1',
                    child => bag(
                        {parent => 'sub-dir1'},
                        {parent => 'sub-dir2'})},
                   {parent => 'dir2',
                    child => bag(
                       {parent => 'sub-dir1',
                        child  => bag({
                           parent => 'sub-sub-dir1',
                           child  => bag({
                               parent => 'sub-sub-sub-dir1'
                           })})})},
                   {parent => 'dir3'});

my $tree = get_tree([], 'paths');
cmp_deeply $tree, $expected, 'same';