Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

coderefs, walktree, OO

by axelrose (Scribe)
on Jan 20, 2002 at 19:41 UTC ( #140211=perlquestion: print w/replies, xml ) Need Help??

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

I'd love to understand why my "find" replacement script failes with directories. The idea is to use a walktree package (you might recognize the origin - Mark-Jason Dominus idendity charts) and create objects for each returned item with another package (FileFinder).

Please excuse the lenghty code. I tried to strip it down as much as possible. The full code runs under MacPerl as well as *nix Perl.

A test case looks like this: (Solaris, Perl 5.005)

$ ./finder.pl /tmp
...
result from finding dirs (ok?):
========================================
994093623 /tmp/.rpc_door
994093644 /tmp/.pcmcia
994093669 /tmp/.X11-unix
994093669 /tmp/.X11-pipe
994093695 /tmp/.removable
1011496217 /tmp
result from finding dirs (broken?):
========================================
1011496217 /tmp
done.
The problematic code is near the end and marked with ### THIS ... Thanks so much,
Axel
#!/usr/local/bin/perl -w { ### remove above line if modules are in their own files package WalkTree; use strict; my $DIRSEP = $^O =~ /Mac/ ? ':' : $^O =~ /Win|OS-2|DOS/ ? '\\' : '/'; my $MACOS = ( $^O =~ /Mac/ ) || 0; my $WINOS = ( $^O =~ /Win|OS-2|DOS/ ) || 0; sub walktree { my ( $dir, $filefunc, $dirfunc, $prune ) = @_; $MACOS and $dir =~ s/:$//; if ( -d $dir ) { if( $prune ) { return undef if $dir =~ /$prune/o } my @values; local *DH; opendir DH, $dir or warn "opendir '$dir' failed\n$!"; my $file; while ( defined( $file = readdir DH )) { !$MACOS and next if( $file eq '.' or $file eq '..' ); $MACOS and next if( $file eq "Icon\n" ); push @values, walktree( "$dir$DIRSEP$file", $filefunc, $dirfunc, $prune ); } closedir DH; ref $dirfunc ? return $dirfunc->($dir, @values) : return @values; } else { ref $filefunc ? return $filefunc->($dir) : return; } } 1; } ### remove above line if modules are in their own files { ### remove above line if modules are in their own files package FileFinder; use strict; # encapsulate { # value 0 makes an attribute non-writable my %_attributes = ( name => 1, ); my $_attributes = sub { keys %_attributes }; my $_cnt; my $_incr_cnt = sub{ $_cnt++ }; sub get_cnt { $_cnt } sub new { my ($caller, %arg) = @_; my $caller_is_obj = ref( $caller ); my $class = $caller_is_obj || $caller; my $self = bless {}, $class; foreach my $member ( $_attributes->() ) { if( $arg{ $member } ) { $self->{ $member } = $arg{ $member } } } my @stat = stat( $self->get_name ); # hash slice assignement @{$self}{ "dev","inode","mode","nlink","uid","gid","rdev", "size","atime","mtime","ctime","blksize","blocks" } = @stat; $_incr_cnt->(); return $self; } } sub get_name { return $_[0]->{name} } sub get_mtime { return $_[0]->{mtime} } 1; } ### remove above line if modules are in their own files use strict; require 5.005; use Getopt::Std; # use WalkTree; # use FileFinder; ### uncomment if packages are in their own files my( $dir, $filter, $prune, @files, $filefunc, $dirfunc ); process_args(); ### THIS RUNS FINE for finding files ### $filefunc = sub { if( $filter ) { $_[0] =~ /$filter/o and FileFinder->new( name => $_[0] ) } else { FileFinder->new( name => $_[0] ) } }; @files = grep{ ref } WalkTree::walktree( $dir, $filefunc, undef, $prune ); print "result from finding files:\n", "=" x 40, "\n"; for ( @files ) { print $_->get_mtime, "\t", $_->get_name, "\n" } ### THIS IS A WORKAROUND for finding directories undef @files; $dirfunc = sub { if( $filter ) { $_[0] =~ /$filter/o and push @files, FileFinder->new( name => $_[0] ) } else { push @files, FileFinder->new( name => $_[0] ) } }; WalkTree::walktree( $dir, undef, $dirfunc, $prune ); print "result from finding dirs (ok?):\n", "=" x 40, "\n"; for ( @files ) { print $_->get_mtime, "\t", $_->get_name, "\n" } ### THIS RETURNS ONLY A SINGLE DIRECTORY, no object reference !??? undef @files; $dirfunc = sub { return undef unless $_[0]; # Mac specific if( $filter ) { $_[0] =~ /$filter/o and FileFinder->new( name => $_[0] ) } else { FileFinder->new( name => $_[0] ) } }; @files = grep{ ref } WalkTree::walktree( $dir, undef, $dirfunc, $prune ); print "result from finding dirs (broken?):\n", "=" x 40, "\n"; for ( @files ) { print $_->get_mtime, "\t", $_->get_name, "\n" } print "done.\n"; ### end of main ### sub process_args { my %opts; getopts( 'f:p:h', \%opts ); $dir = "."; $ARGV[0] and -d $ARGV[0] and $dir = $ARGV[0]; if( $opts{f} ) { eval { $filter = qr/$opts{f}/ } or warn "regex '$opts{f}' cannot be compiled\n"; } if( $opts{p} ) { eval { $prune = qr/$opts{p}/ } or warn "regex '$opts{p}' cannot be compiled\n"; } }

Replies are listed 'Best First'.
Re: coderefs, walktree, OO
by trs80 (Priest) on Jan 20, 2002 at 22:38 UTC
    Well I think I found the problem. In the walktree code, it is passing a directory name and an array into your the dirfunc callback. The callback that is in the current code doesn't account for the incoming list so previous values are removed.
    The workaround code works because it using a strange and dangerous scoping of @files. That is the @files is defined prior to the sub so it is in scope when the sub is created and the values are added to it inside of the $dirfunc callback in walktree, but since its scope is not limited to the $dirfunc callback it could cause problems in the future. So I rewrote the callback to this:
    ### THIS RETURNS ONLY A SINGLE DIRECTORY, no object reference !??? undef @files; $dirfunc = sub { return undef unless $_[0]; # Mac specific my ($dir,@val) = @_; if( $filter ) { $dir =~ /$filter/o and FileFinder->new( name => $dir ) } else { push @val, FileFinder->new( name => $dir ); return @val; } };

    This is only slightly different from the workaround that you present, but it avoids the issues with possible variable scoping issues I think.
      Thanks for the correction. This points me into the right direction, checking conventions of dirfunc() return values.
      I'm having problems though to get it to work when $filter is applied.
        Sorry I completely ignored the $filter code segment, but it appears the $filter is going to suffer from the same fate as the previously discussed code did. The variables need to be passed in and better contained to avoid problems.
        That said, if this is a simple one time utility script, you can get away with the globals, but it is a dangerous practice.
Re: coderefs, walktree, OO
by axelrose (Scribe) on Jan 22, 2002 at 04:21 UTC
    I found a better solution now by making the walktree code clearer to myself (many thanks go to Frank, my local Perl guru :))
    package WalkTree; use strict; my $DIRSEP = $^O =~ /Mac/ ? ':' : $^O =~ /Win|OS-2|DOS/ ? '\\' : '/'; my $MACOS = ( $^O =~ /Mac/ ) || 0; my $WINOS = ( $^O =~ /Win|OS-2|DOS/ ) || 0; sub walktree { my ( $dir, $filefunc, $dirfunc, $prune ) = @_; my @values; $MACOS and $dir =~ s/:$//; if ( -d $dir ) { if( $prune and $dir =~ /$prune/o ) { return undef } ref $dirfunc and $dirfunc->( $dir ); local *DH; opendir DH, $dir or warn "opendir '$dir' failed\n$!"; my $entry; while ( defined( $entry = readdir DH )) { !$MACOS and next if( $entry eq '.' or $entry eq '..' ); $MACOS and next if( $entry eq "Icon\n" ); my $fullpath = "$dir$DIRSEP$entry"; if( -d $fullpath ) { walktree( $fullpath, $filefunc, $dirfunc, $prune ); } elsif( -f $fullpath ) { ref $filefunc and $filefunc->( $fullpath ); } push @values, $fullpath; } closedir DH; } else { warn "$PACKAGE::walktree() - need a directory argument\n"; } return @values; } 1;
    This way I can achieve what I wanted - creating objects on the fly while walktree is doing its job.
    my $filefunc = sub { if( $filter ) { $_[0] =~ /$filter/o and push @files, File->new( name => $_[0] +) } else { push @files, File->new( name => $_[0] ) } }; WalkTree::walktree( $dir, $filefunc, sub { push @dirs , File->new( name => $_[0] ) }, $prune );
    A different question now is whether a different design would be easier to maintain.

    I found Randal Schwartz Linux Mag column using tie() in TieFinder very appealing. He manages to get results in the moment of a successful match.

    Perhaps I should post the final result into the "Craft" categorie. It is most helpful on Macs where you can't do searching with pattern matching on filenames otherwise.

    Thanks to everybody following my chaotic ideas.
      I've made a complete example available in the Code section
      flexible find

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://140211]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (6)
As of 2020-06-03 13:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you really want to know if there is extraterrestrial life?



    Results (24 votes). Check out past polls.

    Notices?