File::Find::Match - Perform different actions on files based on file name.


File-Find-Match documentation Contained in the File-Find-Match distribution.

Index


Code Index:

NAME

Top

File::Find::Match - Perform different actions on files based on file name.

SYNOPSIS

Top

    #!/usr/bin/perl
    use strict;
    use warnings;
    use File::Find::Match qw( :constants );
	use File::Find::Match::Util qw( filename );

    my $finder = new File::Find::Match(
        filename('.svn') => sub { IGNORE },
        qr/\.pm$/ => sub {
            print "Perl module: $_[0]\n";
            MATCH;
        },
        qr/\.pl$/ => sub {
            print "This is a perl script: $_[0]\n";
            # let the following rules have a crack at it.
        },
        qr/filer\.pl$/ => sub {
            print "myself!!! $_[0]\n";
            MATCH;
        },
        -d => sub {
            print "Directory: $_[0]\n";
            MATCH;
        },
        # default is like an else clause for an if statement.
        # It is run if none of the other rules return MATCH or IGNORE.
        default => sub {
            print "Default handler.\n";
            MATCH;
        },
    );

    $finder->find;




DESCRIPTION

Top

This module is allows one to recursively process files and directories based on the filename. It is meant to be more flexible than File::Find.

METHODS

Top

new($predicate => $action, ...)

Creates a new File::Find::Match object.

new() accepts a list of $predicate => $action pairs.

See RULES for a detailed description.

find(@dirs)

Start the breadth-first search of @dirs (defaults to '.' if empty) using the specified rules.

The return value of this function is unimportant.

EXPORTS

Top

Two constants are exported: IGNORE and MATCH.

See Actions for usage.

RULES

Top

A rule is a predicate => action pair.

A predicate is the code (or regexp, see below) used to determine if we want to process a file.

An action is the code we use to process the file. By process, I mean anything from sending it through a templating engine to printing its name to STDOUT.

Predicates

A predicate is one of: a Regexp reference from qr//, a subroutine reference, or a string.

Naturally for regexp predicates, matching occures when the pattern matches the filename.

For coderef predicates, the coderef is called with one argument: the filename to be matched. If it returns a true value, the predicate is true. Else the predicate is false.

The 'default' string predicate is magical. It must only be specified as a predicate once, and it is called after all predicates, regardless of the order.

Any other string will be evaluated as perl code. In addition, $_ will be set to the first argument. Thus a predicate of '-r' is the same as sub { -r $_[0] } (because -r defaults to using $_).

Any exceptions (e.g. calling die(), or synax errors) within the eval'd perl code will be raised to the caller.

Actions

An action is just a subroutine reference that is called when its associated predicate matches a file. When an action is called, its first argument will be the filename.

If an action returns IGNORE or MATCH, all following rules will not be tried. You should return IGNORE when you do not want to recurse into a directory, and MATCH otherwise. On non-directories, both MATCH and IGNORE do the same thing: they prevent the next rule from being tried.

If an action returns niether IGNORE nor MATCH, the next rule will be tried.

BUGS

Top

None known. Bug reports are welcome.

Please use the CPAN bug ticketing system at http://rt.cpan.org/. You can also mail bugs, fixes and enhancements to <bug-file-find-match at rt.cpan.org>.

AUTHOR

Top

Dylan William Hardison <dhardison@cpan.org>

http://dylan.hardison.net/

SEE ALSO

Top

File::Find::Match::Util, File::Find, perl(1).

COPYRIGHT and LICENSE

Top


File-Find-Match documentation Contained in the File-Find-Match distribution.

package File::Find::Match;
use 5.008;
use strict;
use warnings;
use base 'Exporter';
use File::Basename ();
use Carp;

use constant {
	RULE_PREDICATE   => 0,
	RULE_ACTION      => 1,
	
    # Author's birth year: 1985. :)
	IGNORE => \19,
	MATCH  => \85,
};


our $VERSION    = '1.0';
our @EXPORT     = qw( IGNORE MATCH );
our @EXPORT_OK  = @EXPORT;
our %EXPORT_TAGS = (
	constants => [ @EXPORT ],
	all       => [ @EXPORT ],
);

sub new {
	my ($this) = shift;
	my $self = bless {}, $this;

	$self->_rules(@_);

	return $self;
}

sub _rules {
	my $self = shift;
	
	while (@_) {
		my ($predicate, $action) = (shift, shift);
        croak "Undefined action!" unless defined  $action;
		my $act  = $self->_make_action($action);
        if ($predicate eq 'default') {
            $self->{default} = $action;
            next;
        }        
		my $pred = $self->_make_predicate($predicate);
        
		push @{ $self->{rules} }, [$pred, $action];
	}

	return $self;
}

sub rule {
	my $self = shift;
	warn "rules() and rule() are deprecated! Please pass rules to new() from now on.\n";
	$self->_rules(@_);
}
*rules = \&rule;


sub find {
	my ($self, @files) = @_;
	my @rules   = @{ $self->{rules} };

	if (exists $self->{default}) {
		push @rules, [ sub { 1 }, $self->{default} ];
	}

	unless (@files) {
		@files = ('.');
	}

	FILE: while (@files) {
		my $path = shift @files;
		
		RULE: foreach my $rule (@rules) {
			if ($rule->[RULE_PREDICATE]->($path)) {
				my $v = $rule->[RULE_ACTION]->($path) || 0;
				if (ref $v) {
					next FILE if $v == IGNORE;
					last RULE if $v == MATCH;
				}
			}
		}
		
		if (-d $path) {
			my $dir;
			opendir $dir, $path;
			
			# read all files from $dir
			# skip . and ..
			# prepend $path/ to the file name.
			# append to @files.
			push @files, map { "$path/$_" } grep(!/^\.\.?$/, readdir $dir);
			
			closedir $dir;
		}
	}
}

# Take a predicate and return a coderef.
sub _make_predicate {
	my ($self, $pred) = @_;
	my $ref =  ref($pred) || '';
	
	croak "Undefined predicate!" unless defined $pred;
	
	# If it is a qr// Regexp object,
	# the predicate is the truth of the regex.
    if ($ref eq 'Regexp') {
		return sub { $_[0] =~ $pred };
	}
	# If it's a sub, just return it.
	elsif ($ref eq 'CODE') {
		return $pred;
	} 
    elsif (not $ref) {
    	if ($pred eq 'dir') {
    		warn "the predicate 'dir' is deprecated.\n";
    		$pred = '-d';
    	} elsif ($pred eq 'file') {
    		warn "the predicate 'file' is deprecated.\n";
    		$pred = '-f';
    	}
        my $code = eval "sub { package main; \$_ = shift; $pred }";
        if ($@) {
            die $@;
        }
        return $code;
    }   
    # All other values are illegal.
	else {
		croak "Predicate must be a string, code reference, or regexp reference.";
	}
}

# Take an action and return a coderef.
sub _make_action {
	my ($self, $act) = @_;
	
	if (UNIVERSAL::isa($act, 'UNIVERSAL')) {
		# it's an object. Does it support action?
		if ($act->can('action')) {
			return sub { $act->action(shift) };
		} else {
			croak "Action object must support action() method!"
		}
	} elsif (ref($act) eq 'CODE') {
		return $act;
	} else {
		croak "Action must be a coderef or an object.";
	}
}

1;
__END__