unshift @queue, map { [$_, $hash] } @new_paths;
####
while (my $next = shift @queue) {
my ($path, $ref) = @$next;
...
##
##
$ref->{$basename} = do { ... };
##
##
use strict;
use warnings;
use diagnostics;
use File::Basename; # basename
use File::Spec::Functions; # catdir
use Data::Dumper; # Dumper
use Data::Dump; # dd
use constant DD => 1; # 0 = none, 1 = Dumper, 2 = Dump
my $data = data_for_path('./test'); # '/root/excerise_perl/test'
print "RESULT:\n";
DD == 2 ? dd $data : print Dumper($data); # default to Data::Dumper
sub data_for_path
{
my ($path) = @_;
my $data = {};
my @queue = ( [ $path, $data ] );
my $count = 0;
show_queue($count, \@queue) if DD;
while (my $next = shift @queue)
{
if (DD)
{
print "($count) \$next:\n";
DD == 2 ? dd $next : print Dumper($next);
print '=' x 50, "\n";
}
my ($path, $ref) = @$next;
my $basename = basename($path);
$ref->{$basename} = do
{
if (-f $path or -l $path) # plain file or symbolic link
{
undef;
}
else
{
my $hash = {};
opendir((my $dh), $path);
my @new_paths = map { catfile $path , $_ }
grep { !/^\.\.?\z/ } readdir $dh;
unshift @queue, map { [$_, $hash] } @new_paths;
$hash;
}
};
}
continue
{
show_queue(++$count, \@queue) if DD;
}
$data;
}
sub show_queue
{
my ($count, $queue) = @_;
print "($count) \@queue:\n";
DD == 2 ? dd $queue : print Dumper($queue);
print '-' x 50, "\n";
}
##
##
14:34 >perl 1620_SoPW.pl
(0) @queue:
$VAR1 = [
[
'./test',
{}
]
];
--------------------------------------------------
(0) $next:
$VAR1 = [
'./test',
{}
];
==================================================
(1) @queue:
$VAR1 = [
[
'test\\dir1',
{}
],
[
'test\\file1',
$VAR1->[0][1]
],
[
'test\\file2',
$VAR1->[0][1]
]
];
--------------------------------------------------
(1) $next:
$VAR1 = [
'test\\dir1',
{}
];
==================================================
(2) @queue:
$VAR1 = [
[
'test\\dir1\\file3',
{}
],
[
'test\\file1',
{
'dir1' => $VAR1->[0][1]
}
],
[
'test\\file2',
$VAR1->[1][1]
]
];
--------------------------------------------------
(2) $next:
$VAR1 = [
'test\\dir1\\file3',
{}
];
==================================================
(3) @queue:
$VAR1 = [
[
'test\\file1',
{
'dir1' => {
'file3' => undef
}
}
],
[
'test\\file2',
$VAR1->[0][1]
]
];
--------------------------------------------------
(3) $next:
$VAR1 = [
'test\\file1',
{
'dir1' => {
'file3' => undef
}
}
];
==================================================
(4) @queue:
$VAR1 = [
[
'test\\file2',
{
'dir1' => {
'file3' => undef
},
'file1' => undef
}
]
];
--------------------------------------------------
(4) $next:
$VAR1 = [
'test\\file2',
{
'dir1' => {
'file3' => undef
},
'file1' => undef
}
];
==================================================
(5) @queue:
$VAR1 = [];
--------------------------------------------------
RESULT:
$VAR1 = {
'test' => {
'file1' => undef,
'file2' => undef,
'dir1' => {
'file3' => undef
}
}
};
14:34 >