在 Perl 中创建符合 Fancytree 预期 JSON 格式的目录树

Question

如何在 Perl 中创建目录树以符合 Fancytree 预期 JSON format?

这是我提出的 Perl 部分，它遍历给定路径：

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

它returns经过JSON编码后的结果如下：

 {
  "dir3":{

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

    },
    "sub-dir1":{

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

        }
      }
    }
  }
}

Fancytree 符合其 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"}
    ]}
]

重点是在单个运行中完成，无需 post 处理，这将是理想的。

如何实现这一目标的任何帮助？

Answer 1

我猜下面会产生你想要的结构。

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({wanted=>$c, preprocess=> sub { grep { -d  $_ } @_; } }, $gpath);

Answer 2

使用递归代替File::Find，使用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

你可以试试，

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 4

总结一下，这是最终代码，它将立即生成 Fancytree 期望的有效 JSON 对象。感谢所有愿意花时间和提供帮助的人。

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

我在 Authentic Theme for Webmin/Usermin 文件管理器中使用它。

在 21 世纪最好的服务器管理面板上试试吧♥️

在 Perl 中创建符合 Fancytree 预期 JSON 格式的目录树

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

perl

tree-traversal

fancytree