axelrose has asked for the wisdom of the Perl Monks concerning the following question:
#!/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 | |
by Anonymous Monk on Jan 21, 2002 at 01:38 UTC | |
by trs80 (Priest) on Jan 21, 2002 at 04:42 UTC | |
|
Re: coderefs, walktree, OO
by axelrose (Scribe) on Jan 22, 2002 at 04:21 UTC | |
by axelrose (Scribe) on Jan 28, 2002 at 02:49 UTC |