Tentativo 1
Una soluzione che usa solo perl, restituendo un semplice hash di struttura di hash. Prima dell'OP chiariva il formato dei dati di JSON.
#! /usr/bin/perl
use File::Find;
use JSON;
use strict;
use warnings;
my $dirs={};
my $encoder = JSON->new->ascii->pretty;
find({wanted => \&process_dir, no_chdir => 1 }, ".");
print $encoder->encode($dirs);
sub process_dir {
return if !-d $File::Find::name;
my $ref=\%$dirs;
for(split(/\//, $File::Find::name)) {
$ref->{$_} = {} if(!exists $ref->{$_});
$ref = $ref->{$_};
}
}
File::Find
Il modulo funziona in modo simile al find
comando unix . Il JSON
modulo prende le variabili perl e le converte in JSON.
find({wanted => \&process_dir, no_chdir => 1 }, ".");
Scorrerà la struttura del file dalla directory di lavoro corrente chiamando la subroutine process_dir
per ciascun file / directory in "." E no_chdir
dirà a perl di non emettere un chdir()
per ogni directory che trova.
process_dir
ritorna se il file esaminato attuale non è una directory:
return if !-d $File::Find::name;
Quindi prendiamo un riferimento dell'hash esistente %$dirs
in $ref
, dividiamo il percorso del file /
e eseguiamo il ciclo con l' for
aggiunta di una nuova chiave hash per ogni percorso.
Creare una struttura di directory come ha fatto slm:
mkdir -p dir{1..5}/dir{A,B}/subdir{1..3}
L'output è:
{
"." : {
"dir3" : {
"dirA" : {
"subdir2" : {},
"subdir3" : {},
"subdir1" : {}
},
"dirB" : {
"subdir2" : {},
"subdir3" : {},
"subdir1" : {}
}
},
"dir2" : {
"dirA" : {
"subdir2" : {},
"subdir3" : {},
"subdir1" : {}
},
"dirB" : {
"subdir2" : {},
"subdir3" : {},
"subdir1" : {}
}
},
"dir5" : {
"dirA" : {
"subdir2" : {},
"subdir3" : {},
"subdir1" : {}
},
"dirB" : {
"subdir2" : {},
"subdir3" : {},
"subdir1" : {}
}
},
"dir1" : {
"dirA" : {
"subdir2" : {},
"subdir3" : {},
"subdir1" : {}
},
"dirB" : {
"subdir2" : {},
"subdir3" : {},
"subdir1" : {}
}
},
"dir4" : {
"dirA" : {
"subdir2" : {},
"subdir3" : {},
"subdir1" : {}
},
"dirB" : {
"subdir2" : {},
"subdir3" : {},
"subdir1" : {}
}
}
}
}
Tentativo 2
Va bene ora con diversa struttura dei dati ...
#! /usr/bin/perl
use warnings;
use strict;
use JSON;
my $encoder = JSON->new->ascii->pretty; # ascii character set, pretty format
my $dirs; # used to build the data structure
my $path=$ARGV[0] || '.'; # use the command line arg or working dir
# Open the directory, read in the file list, grep out directories and skip '.' and '..'
# and assign to @dirs
opendir(my $dh, $path) or die "can't opendir $path: $!";
my @dirs = grep { ! /^[.]{1,2}/ && -d "$path/$_" } readdir($dh);
closedir($dh);
# recurse the top level sub directories with the parse_dir subroutine, returning
# a hash reference.
%$dirs = map { $_ => parse_dir("$path/$_") } @dirs;
# print out the JSON encoding of this data structure
print $encoder->encode($dirs);
sub parse_dir {
my $path = shift; # the dir we're working on
# get all sub directories (similar to above opendir/readdir calls)
opendir(my $dh, $path) or die "can't opendir $path: $!";
my @dirs = grep { ! /^[.]{1,2}/ && -d "$path/$_" } readdir($dh);
closedir($dh);
return undef if !scalar @dirs; # nothing to do here, directory empty
my $vals = []; # set our result to an empty array
foreach my $dir (@dirs) { # loop the sub directories
my $res = parse_dir("$path/$dir"); # recurse down each path and get results
# does the returned value have a result, and is that result an array of at
# least one element, then add these results to our $vals anonymous array
# wrapped in a anonymous hash
# ELSE
# push just the name of that directory our $vals anonymous array
push(@$vals, (defined $res and scalar @$res) ? { $dir => $res } : $dir);
}
return $vals; # return the recursed result
}
E quindi eseguendo lo script sulla struttura di directory proposta ...
./tree2json2.pl .
{
"dir2" : [
"dirB",
"dirA"
],
"dir1" : [
"dirB",
{
"dirA" : [
"dirBB",
"dirAA"
]
}
]
}
Ho trovato questo dannatamente complicato da ottenere (soprattutto dato la logica "hash if sub directory, array if not, OH UNLESS top level, then hashas comunque"). Quindi sarei sorpreso se questo fosse qualcosa che potevi fare con sed
/ awk
... ma poi Stephane non l'ha ancora visto, scommetto :)