File Coverage

blib/lib/File/Find/Mason.pm

Criterion	Covered	Total	%
statement	50	62	80.6
branch	24	36	66.6
condition			n/a
subroutine	7	7	100.0
pod	2	2	100.0
total	83	107	77.5

package File::Find::Mason;

use strict;
use warnings;
use File::Find qw//;

our $VERSION='0.0.7';

my %default=(
	verbose    =>0,
	shebang    =>1,
	args       =>1,
	once       =>1,
	perl       =>1,
	call       =>1,
	modeline   =>1,
);

my %pattern=(
	shebang    =>qr/^#!.*\w/,
	args       =>qr/^<%args>/,
	once       =>qr/^<%once>/,
	perl       =>qr/^<%perl>/,
	call       =>qr/^<&.*&>/,
	modeline   =>qr/^% *#.*mason/,
);

my $optpattern=join('|',keys %default);

sub find {
	my ($options,@dirs)=@_;
	my %findopt;
	foreach my $k (grep {!/^(?:$optpattern)$/} keys(%$options)) { $findopt{$k}=$$options{$k} }
	if($$options{wanted}) {
		my $cb=$$options{wanted};
		File::Find::find({%findopt, no_chdir=>1, wanted=>sub {
			if(-d $File::Find::name) { return }
			if(wanted($options,$File::Find::name)) { &$cb() }
		} },@dirs);
	}
	else {
		my @res;
		File::Find::find({%findopt, no_chdir=>1, wanted=>sub {
			if(-d $File::Find::name) { return }
			if(wanted($options,$File::Find::name)) { push @res,$File::Find::name }
		} },@dirs);
		return @res;
	}
}

sub wanted {
	my ($options,$fn)=@_;
	my %opt=(%default,%$options);
	if(!-e $fn) { if($opt{verbose}) { print STDERR "File not found:  $fn\n" }; return }
	if(!-r $fn) { if($opt{verbose}) { print STDERR "Unable to read:  $fn\n" }; return }
	my ($fh,$txt);
	if(!open($fh,'<',$fn)) { if($opt{verbose}) { print STDERR "Unable to read:  $fn\n" }; return }
	{local($/); $txt=<$fh>}
	close($fh);
	if(!$txt) {
		if($opt{verbose}) { print STDERR "No content for $fn\n" }
		return 0;
	}
	foreach my $k (grep {$opt{$_}&&$pattern{$_}} keys(%default)) {
		if($k eq 'shebang') { if($txt=~$pattern{$k}) { return 0 } }
		if($txt=~$pattern{$k}) {
			if($opt{wanted}) { return &{$opt{wanted}}($fn) }
			else             { return 1 }
		}
	}
	return 0;
}

1;

__END__