#!/usr/local/bin/perl -w
use strict;
require 5.005;
use Getopt::Std;
# uncomment if modules from BEGIN block below
# are put into separate files
# use WalkTree;
# use File;
my ( $dir, $filter, $prune, @files, @dirs );
process_args();
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, undef, $prune );
unless( @files ) { print "no result\n"; exit 1 }
print File->get_cnt(), " files found\n";
my @name_and_mtime = map { {
name => $_->get_name,
mtime => $_->get_mtime,
mtime_string => $_->get_mtime_string
} } @files;
my @mtime_sorted = sort { $a->{mtime} <=> $b->{mtime} } @name_and_mtim
+e;
print "mtime sorted list of found files:\n", "-" x 40, "\n";
for ( @mtime_sorted ) {
print $_->{mtime_string}, "\t", $_->{name}, "\n";
}
print "=" x 40, "\n";
print "runtime: ", time - $^T, " seconds.\n";
print "done.\n";
### end of main ###
# modules usually go into extra files, but to show code:
BEGIN{
{
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;
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 =~ /\n/;
my $fullpath;
if( $MACOS ) { -d "$dir$entry" ? ($fullpath = "$dir$entry$DIRSEP
+") : ($fullpath = "$dir$entry") }
else { $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 "Walktree::walktree() - need a directory argument\nyou provid
+ed '$dir'\n";
}
return @values;
}
1;
}
{
package File;
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_dev { return $_[0]->{dev} }
sub get_inode { return $_[0]->{inode} }
sub get_mode { return $_[0]->{mode} }
sub get_nlink { return $_[0]->{nlink} }
sub get_uid { return $_[0]->{uid} }
sub get_gid { return $_[0]->{gid} }
sub get_rdev { return $_[0]->{rdev} }
sub get_size { return $_[0]->{size} }
sub get_atime { return $_[0]->{atime} }
sub get_mtime { return $_[0]->{mtime} }
sub get_ctime { return $_[0]->{ctime} }
sub get_blksize { return $_[0]->{blksize} }
sub get_blocks { return $_[0]->{blocks} }
sub get_atime_string { return _time2string( $_[0]->{atime} ) }
sub get_ctime_string { return _time2string( $_[0]->{ctime} ) }
sub get_mtime_string { return _time2string( $_[0]->{mtime} ) }
sub _time2string {
my $in = shift;
my( $sec, $min, $hour, $mday, $mon, $year ) = (localtime $in )[0,1
+,2,3,4,5];
$mon++; $year += 1900;
return sprintf "%02d.%02d.%d %02d:%02d:%02d", $mday, $mon, $year,
+$hour, $min, $sec;
}
1;
}
}
sub process_args {
my $MACOS = ( $^O =~ /Mac/ ) || 0;
# default dir
$MACOS ? ($dir = ":") : ($dir = ".");
# give Macs a chance to provide command line parameters
if( $MACOS ) {
my $ans = MacPerl::Ask( 'Please enter @ARGV (-h for help)', define
+d $ARGV[0] ? $ARGV[0] : "" );
if( $ans ) {
usage() if $ans =~ /\b-h\b/;
my $args = splitargs( $ans );
@ARGV = @$args;
}
else { $ARGV[0] = ":" }
}
my %opts;
getopts( 'f:p:h', \%opts );
usage() if $opts{h};
$ARGV[0] and -d $ARGV[0] and $dir = $ARGV[0] or warn "using default
+searchdir '$dir'\n";
if( $opts{f} ) {
eval { $filter = qr/$opts{f}/ }
or warn "regex '$opts{f}' cannot be compiled, continuing without
+ filter\n";
}
if( $opts{p} ) {
eval { $prune = qr/$opts{p}/ }
or warn "regex '$opts{p}' cannot be compiled, continuing without
+ pruning\n";
}
## print "DEBUG: dir = $dir, filter = $filter, prune = ", defined $p
+rune ? $prune : "undef", "\n";
}
sub splitargs {
my $s = shift;
$s =~ s/^\s*//;
$s =~ s/\s*$//;
$s .= ":" unless $s =~ /:$/;
my( $first, $rest, @args, $firstval, $firstvalcomplete );
while( ($_ = $s) =~ /^(-.)(.*)/ ) {
($first, $rest) = ( $1, $2 );
($firstvalcomplete, $firstval) = ($rest =~ /(^\s*(.+?)\s+)/);
$s =~ s/\Q$first$firstvalcomplete\E//;
push @args, ($first, $firstval);
}
push @args, $s;
return \@args;
}
sub usage {
print <<eom;
$0 [-f <filter>] [-p <prune>] [-h] <search directory start>
all arguments are optional
default filter is undef
default prune is undef
defaults search directory is current working directory
examples:
-f pl\$ -p (?i)example /tmp
-f pl\$ Macintosh HD:my projects:
eom
exit 1;
}
__END__
=head1 NAME
walktree-finder.pl - portable find replacement
=head1 SYNOPSIS
all arguments are optional
default filter is undef
default prune is undef
defaults search directory is current working directory
examples:
-f pl$ -p (?i)example /tmp
on Macs:
-f pl$ Macintosh HD:my projects:
or build a droplet and drop a folder onto it
=head1 DESCRIPTION
Demonstration of OO techniques, replacement of File::Find for shortnes
+s and flexibility.
WalkTree was taken from "The Idendity Function" slides provided by Mar
+k-Jason Dominus at
http://www.plover.com/~mjd/
=head1 BUGS/TODO
=head1 AUTHOR
Axel Rose, Winter 2001
=head1 VERSION
$Id$
=cut
-
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.