http://qs1969.pair.com?node_id=1170878

exilepanda has asked for the wisdom of the Perl Monks concerning the following question:

A little background first. I am working on Win7 and going to develop a dir tree walker module. Since File::List won't deal with utf8 file names, neither dir /b/s(mush faster though). I am going to build this dir walker module with Win32::Unicode::Dir. Since a single thread goes really so slow, so I want to use thread as well. So, here's my work so far, but things goes really weird.
$| = 1; package Vz::DirTree; use Data::Dumper; use strict; use threads ; use threads::shared; use Devel::Pointer; sub _fetchDir { my ( $c , $root ) = @_; print "$root>$/"; my $dir; eval { opendir $dir, $root or die "$! Can't open '$root'" }; return if $@; foreach my $file ( readdir $dir ) { next if $file =~/^\.{1,2}/; $file = "$root/$file"; # print $file. $/; <------ Uncomment if you want to see progre +ss push @{$c->{isFile}}, $file if -f $file; push @{$c->{isDir}}, $file if -d $file; push @{$c->{dirToFetch}}, $file if -d $file; } closedir $dir; } sub _walk { my $addr = shift; my $obj = deref ( $addr ) ; my $root = shift ( @{$obj->{dirToFetch}} ) ; $obj -> _fetchDir ( $root ) ; } sub setRoot { my $c = shift; my $root = shift; $root = "./" unless $root; my $self = bless { dirToFetch => [], isDir => [], isFile => [], }, $c; $self->_fetchDir ($root); # first scan from root dir my $objAddr : shared = address_of ( $self ) ; while ( @{$self->{dirToFetch}} ) { sleep 1; threads->create ( '_walk' , $objAddr ) -> join; } return $self; } 1; package main; use Data::Dumper; my $dir = Vz::DirTree->setRoot ( "M:/" ) ; print Dumper $dir;
This code never able run to the end, but depends on different dir that I set as root, different error can pop out. What errors I've seen so far includes:

- scalars leaks: -1 ( or some -ve number )
- Free to wrong pool 2278d00 not 7349a8 during global destruction.
- Bizarre SvTYPE $someNum

Any idea why this code goes that wrong??? What result will show up in your box?? Any clue is much appreciated.

UPDATE: This will Work!

package Vz::DirTree; use Data::Dumper; use strict; use threads ; use threads::shared; my @dirToFetch : shared ; my @isFile : shared; my @isDir : shared; my @warn : shared; my $ModuleBusy; sub _fetchDir { my $root = shift; my $dir; eval { opendir $dir, $root or die "$! Can't open '$root'" }; if ( $@ ) { push @warn, $root ; return undef; } foreach my $file ( readdir $dir ) { next if $file =~/^\.{1,2}/; $file = "$root/$file"; if ( -f $file ) { push @isFile, $file if -f $file; } elsif ( -d $file ) { push @isDir, $file; push @dirToFetch, $file; } } closedir $dir; } sub setRoot { my $c = shift; my $root = shift; $root = "./" unless $root; my $waitIfBusy = grep { /-WaitIfBusy/ } @_ ? 1 : 0 ; if ( $ModuleBusy && ! $waitIfBusy ) { die __PACKAGE__ . " is busy. Pass -WaitIfBusy as argv if you c +an wait "; } elsif ( $ModuleBusy && $waitIfBusy ) { sleep 1 until ! $ModuleBusy } $ModuleBusy = 1; my $self = bless {isDir => [], isFile => [], duration => und +ef}, $c; _fetchDir ($root); # first scan from root dir my $startTime = time; my $walker = threads-> create ( sub { while ( @dirToFetch ) { my $t = scalar(threads->list); next if $t > @dirToFetch; # so that threads will not empty @dirToFetch before # other thread finish their result back to @dirToFetch +. threads->create ( sub { _fetchDir(shift(@dirToFetch))} ) ; } }); while (threads->list) { my $t = scalar(threads->list); $self->{MaxThreadHit} = $t if $t > $self->{MaxThreadHit}; $_ -> join foreach ( threads->list ( threads::joinable ) ) ; } my $endTime = time; $self -> {duration} = $endTime - $startTime ; @{$self->{isDir}} = @isDir; @{$self->{isFile}} = @isFile; @{$self->{failOpen}} = @warn; @isFile = (); @isDir=(); @warn=(); $ModuleBusy = 0; return $self; } 1; package main; use Data::Dumper; my $dir = Vz::DirTree->setRoot ( "M:/" ) ; print Dumper $dir;