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 >