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

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';

Answer 3

I guess the following would produce the structure you wanted.
test.pl
use strict;
use warnings;
use JSON;
sub get_json
{
return JSON->new->latin1->pretty->encode(#_);
}
sub get_tree
{
my ($gpath) = #_;
my (%r,#rr);
use File::Find;
my $c = sub {
my $dir = $File::Find::name;
my $r = \%r;
my $rr = \#rr;
my $tdir = $dir;
$tdir =~ s|^\Q$gpath\E/?||;
my $previtem;
for my $item(split m|/|, $tdir) {
if ($previtem) {
$rr=$r->{$previtem}[1]{child}//=[];
$r= $r->{$previtem}[0]{child}//={};
}
$r->{$item} //= [ { }, $rr->[#$rr]= { parent=>$item } ];
$previtem = $item;
}
};
find($c, $gpath);
return \%r,\#rr;
}
my ($r,$rr) = get_tree($ARGV[0]);
print get_json($rr);
output
[
{
"parent" : "test.pl"
},
{
"parent" : "dir1",
"child" : [
{
"parent" : "sub-dir1"
},
{
"parent" : "sub-dir2"
}
]
},
{
"parent" : "dir2",
"child" : [
{
"parent" : "sub-dir1",
"child" : [
{
"parent" : "sub-sub-dir1"
}
]
}
]
},
{
"parent" : "dir3"
}
]
I've run it: perl test.pl .. So you see 'test.pl' in the output
In case you want to traverse only directories, change the find call to:
find({wanted=>$c, preprocess=> sub { grep { -d $_ } #_; } }, $gpath);

Answer 4

Summarizing, here is the final code, that will produce valid JSON object expected by Fancytree out of the box. Thanks to everyone, who was generous to spend time and provide help.
Perl:
#!/usr/bin/perl
use warnings;
use strict;
=head2 get_tree(path, [depth])
Build sorted directory tree in format expected by Fancytree
=item path - The path from which to start searching.
=item depth - The optional parameter to limit the depth.
=cut
use File::Find;
use JSON;
sub get_tree {
my ( $p, $d ) = #_;
my $df = int($d);
my %r;
my #r;
my $wanted = sub {
my $td = $File::Find::name;
if ( -d $td ) {
$td =~ s|^\Q$p\E/?||;
if ( $r{$td} || !$td ) {
return;
}
my ( $pd, $cd ) = $td =~ m|^ (.+) / ([^/]+) \z|x;
my $pp = $p ne '/' ? $p : undef;
my $c = $r{$td} = {
key => "$pp/$td",
title => ( defined($cd) ? $cd : $td )
};
defined $pd ? ( push #{ $r{$pd}{children} }, $c ) : ( push #r, $c );
}
};
my $preprocess = sub {
my $dd = ( $df > 0 ? ( $df + 1 ) : 0 );
if ($dd) {
my $d = $File::Find::dir =~ tr[/][];
if ( $d < $dd ) {
return sort #_;
}
return;
}
sort #_;
};
find(
{
wanted => $wanted,
preprocess => $preprocess
},
$p
);
return \#r;
}
# Retrieve JSON tree of `/home` with depth of `5`
JSON->new->encode(get_tree('/home', 5));
JavaScript:
$('.container').fancytree({
source: $.ajax({
url: tree.cgi,
dataType: "json"
})
});
I'm using it in Authentic Theme for Webmin/Usermin for File Manager.
Try it on the best server management panel of the 21st Century ♥️