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?

Could you include a shell script to create the exact directory structure you are using please? — simbabque, Mar 17 '18 at 14:15
It's Perl. Just paste it to the `.cgi` file with `#!/usr/bin/perl`, add the sub there and then run it. Example: `get_tree('/root')`. That's all. — Ilia Ross, Mar 17 '18 at 14:17
You misunderstand. I want code to create a directory structure that matches your exact one in your example so I can copy/paste your code and your expected output to test against. I don't want to fiddle with getting the correct folders manually. Something like `mkdir dir1; mkdir dir1/sub-dir1` and so on. — simbabque, Mar 17 '18 at 14:18
Okay, I see, here is the Perl file to use: https://gist.github.com/qooob/0cf71b699bb9c2446ca14a0b2c01b04d and I will post the command, hold on a second. — Ilia Ross, Mar 17 '18 at 14:21
Do you really want only the directories in the structure, or should there be files in there as well? If so, then what should they look like, as a `parent` field is irrelevant? — Borodin, Mar 17 '18 at 14:25
@Borodin I only expect directories to be there, no files. It's the tree-view that I'm making for Authentic Theme for Webmin/Usermin. — Ilia Ross, Mar 17 '18 at 14:32
@simbabque Run it on the console to create the same directory structure. `mkdir paths && cd "$_" && mkdir dir3 && mkdir dir2 && mkdir dir1 && cd "$_" mkdir sub-dir1; mkdir sub-dir2; cd ../dir2; mkdir sub-dir1 && cd "$_" && mkdir sub-sub-dir1 && cd "$_" && mkdir sub-sub-sub-dir1`. Then you can use it as `get_tree('/tmp/paths')`. — Ilia Ross, Mar 17 '18 at 14:38
Putting `use` into a sub is confusing. It's called when the sub is compiled, not when it's run. — choroba, Mar 17 '18 at 16:07

mpapec · Accepted Answer · 2018-03-17T17:36:53.313

3

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.

edited Mar 17 '18 at 17:36

answered Mar 17 '18 at 17:31

mpapec

50,217
8
67
127

This is absolutely perfect. Thank you, pal! – Ilia Ross Mar 17 '18 at 18:13
Is there a way to optimize potentially slow regex: `s|^\Q$gpath\E/?||;` – Ilia Ross Mar 17 '18 at 18:13
Besides, as I was trying to find out [here](https://stackoverflow.com/questions/49338323/perl-filefind-name-and-dir-subs-not-returning-expected-results-on-empty-ta), `$File::Find::dir` ignores empty directories. There are commenters stating that `$File::Find::dir` will still use `$File::Find::name` and that makes me very iffy, because it doesn't sound efficient. Do you know the way to force `::dir` to collect empty directories as well? – Ilia Ross Mar 17 '18 at 18:32
For Fancytree to work labels should be `title` and `children`, by the way but this is trivial. – Ilia Ross Mar 17 '18 at 18:33
The code does not output empty directories. @IliaRostovtsev is it what you want? – wolfrevokcats Mar 17 '18 at 19:21
@IliaRostovtsev Re: regex, don't know how to optimize regex, but `-d or return;` before it would skip rest of the function when file is handed over, so potentially skipping some unneeded work. – mpapec Mar 17 '18 at 19:26
No, as I'm creating directory tree-view, all directories should be in the list. @Сухой27 Last question, how hard it is to sort output lexicographically? It's the directory tree so it must be sorted. Using simply sort will not work obviously. – Ilia Ross Mar 17 '18 at 19:29
1

Didn't try it, but perhaps `find({wanted=>$c, preprocess=> sub { sort @_ } }, $gpath)` – mpapec Mar 17 '18 at 19:33
@Сухой27 Simply genius. Thank you! – Ilia Ross Mar 17 '18 at 19:40

choroba · Answer 2 · 2018-03-17T16:19:05.180

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

Thank you, your solution is correct (makes Fancytree on client-side just load), however it's much slower than my initial example. For instance, my `get_tree()` returns the all paths starting from `/` in about 1 second. Your example takes forever for `/`, but `/etc` works alright. Is there a way to make it faster? — Ilia Ross, Mar 17 '18 at 17:01
I don't think we should use `Path::Tiny`,at first, it's not the part of the core modules and second it seems to be slower. Would you like to optimize your code? — Ilia Ross, Mar 17 '18 at 17:21

wolfrevokcats · Answer 3 · 2018-03-17T17:35:10.867

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

Thank you for your answer. The output that is produced unfortunately incorrect. More details here: https://gist.github.com/qooob/0cf71b699bb9c2446ca14a0b2c01b04d — Ilia Ross, Mar 17 '18 at 18:26
@IliaRostovtsev, the gist shows the output of the first value returned by `get_tree` from my answer. The structure you need is actually returned in the second value. Check how the output is printed at the bottom ot the code. — wolfrevokcats, Mar 17 '18 at 19:11
@wolfrevokcats Yes it does. It's not entirely wrong, it's just different. This is why I upvoted your answer. — Ilia Ross, Mar 17 '18 at 19:32

Ilia Ross · Answer 4 · 2018-03-22T10:10:49.773

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 ♥️

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

4 Answers4