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;
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.