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";
  }
}

[download]

In reply to coderefs, walktree, OO by axelrose

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.