Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/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

In reply to flexible find by axelrose

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



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2024-04-25 15:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found