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.
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:$| = 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;
- 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;
|
---|
Back to
Seekers of Perl Wisdom