Create a directory tree in Perl that matches the expected Fancytree JSON format

Question

How to create a directory tree in Perl to match the expected Fancytree JSON format ?

This is the part of Perl that I came across that goes through the 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 encoding:

 {
  "dir3":{

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

    },
    "sub-dir1":{

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

        }
      }
    }
  }
}

Expected result for Fancytree according to its JSON format :

[
    {"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 this in one pass without further processing, which would be ideal.

Any help to achieve this?

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

, @root.

Answer 2

:: , Path::Tiny :

#!/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

, , .

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

[
   {
      "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"
   }
]

---

: perl test.pl .. , "test.pl"

, find :

find({wanted=>$c, preprocess=> sub { grep { -d  $_ } @_; } }, $gpath);  

Answer 4

, , JSON, Fancytree . , .

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

---

Webmin/Usermin .

Try it on the best 21st century server control panel ♥ ️