Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

flexible find

by axelrose (Scribe)
on Jan 27, 2002 at 17:17 UTC ( [id://141931]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info Axel Rose
Description: Here is a little script I always wanted to have: a "find" script which
  • - runs on Macs (and *nix, Windows too)
  • - creates objects while running
  • - has an understandable "-prune" option
  • - uses Perl regex for filtering
This should make it easy to extend the idea for your purpose. The example below outputs found files sorted by modification time. You can change it to list directories sorted by size or by mtime by providing a directory callback function:
my $dirfunc = sub { push @dirs, File->new( name => $_[0] };
WalkTree::walktree( $mystartdir, undef, $dirfunc, undef );


I'm happy about your comments. Best regards, Axel.
#!/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
Replies are listed 'Best First'.
Re: flexible find
by merlyn (Sage) on Jan 27, 2002 at 21:41 UTC
      Many reasons, though perhaps only important to me:

      I used this as an exercise for OO programming. I have so many scripts working on a directory tree, collecting information and doing something with it. The shown script will help me to put it all into a single scheme.

      Using File::Find I import another 5 modules. I like to avoid this for building MacPerl standalones

      Another aspect of the whole script (not concerning File::Find) is having the same "find" interface under MacPerl.

      I was impressed by MJDs Idendity charts

      Lastly - I found your TieFinder example which avoids File::Find too :)

      How could I improve the overall design, be it for educational purposes?
Re: flexible find
by jryan (Vicar) on Jan 28, 2002 at 01:51 UTC
    Its interesting that you say that you want Mac portability, yet use require 5.005. Did you know MacPerl is still on version 5.004? :)
      MacPerl 5.6.1 is currently beta3 and works 99% like a charm.
      I understand "portability" here more in the sense of my own interface to a file finder with direct object creation.
      But I admit - the goal could have achieved with File::Find and 5.004 with ease.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://141931]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (2)
As of 2024-04-26 04:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found