File Coverage

blib/lib/Test/File/Find/Rule.pm

Criterion	Covered	Total	%
statement	18	39	46.1
branch	0	4	0.0
condition	0	4	0.0
subroutine	6	9	66.6
pod	2	3	66.6
total	26	59	44.0

package Test::File::Find::Rule;

use strict;
use base qw(Exporter);
use vars qw(@EXPORT);

use Test::Builder;
use File::Spec;
use Number::Compare;

our $VERSION = '1.00';

@EXPORT = qw(
	match_rule_nb_results
	match_rule_array
	match_rule_no_result
);

my $Test = Test::Builder->new();

=head1 NAME

Test::File::Find::Rule - Test files and directories with File::Find::Rule

=head1 SYNOPSIS

 use Test::File::Find::Rule;

 # Check that all files in $dir have sensible names
 my $rule = File::Find::Rule
     ->file
     ->relative
     ->not_name(qr/^[\w]{1,8}\.[a-z]{3,4}$/);
 match_rule_no_result($rule, $dir, 'File names ok');

 # Check that all our perl scripts have use strict !
 my $rule = File::Find::Rule
    ->file
    ->relative
    ->name(@perl_ext)
    ->not_grep(qr/^\s*use\s+strict;/m, sub { 1 });
 match_rule_no_result($rule, $dir, 'use strict usage');

 # With some help of File::Find::Rule::MMagic
 # Check that there is less than 10 images in $dir
 # with a size > 1Mo
 my $rule = File::Find::Rule
     ->file
     ->relative
     ->magic('image/*')
     ->size('>1Mo');
 match_rule_nb_result($rule, $dir, '<10', 'Few big images');
 # We can reuse our F:F:R object
 match_rule_nb_result($rule, $another_dir, '>100', 'A lot of big images');

 # Check the exact result from a rule
 my $dirs = [qw(web lib data tmp)];
 my $rule = File::Find::Rule
     ->directory
     ->mindepth(1)
     ->maxdepth(1)
     ->relative;
 match_rule_array($rule, $dir, $dirs, 'Directory structure ok'));

=head1 DESCRIPTION

This module provides some functions to test files and directories
with all the power of the wonderful File::Find::Rule module.

The test functionnality is based on Test::Builder.

=head2 EXPORT

 match_rule_nb_results
 match_rule_array
 match_rule_no_result

=head2 FUNCTIONS

=over 4

=item match_rule_nb_result(RULE, DIR, COMPARE [, NAME])

RULE is a File::Find::Rule object without a query method. The
C method will be called automatically.

DIR is a directory. To be safe, I recommend to give an absolute directory
and use the C function for your rule so that error messages
are shorter.

COMPARE is a Number::Compare object. You have to follow
L semantics.

NAME is the optional name of the test.

=cut

# $compare is a Number::Compare string (>3 <10Ki 4 ...)
sub match_rule_nb_results {
	my ($rule, $dir, $compare, $name) = @_;
	$name ||= "Match the rule";

	my @files = $rule->in($dir);
	if (Number::Compare->new($compare)->test(scalar(@files))) {
		$Test->ok(1, $name);
	} else {
		$Test->ok(0, $name);
		$Test->diag("Expected [$compare]");
		$Test->diag("Got      [".scalar(@files)."]");
		$Test->diag("Matched  [".join(', ', @files)."]");
	}
}

=item match_rule_no_result(RULE, DIR [, NAME])

Just a convenient shortcut for

 match_rule_nb_result(RULE, DIR, 0 [, NAME])

=cut

sub match_rule_no_result {
	my ($rule, $dir, $name) = @_;

	match_rule_nb_results($rule, $dir, 0, $name);
}

=item match_rule_array(RULE, DIR, RESULTS [, NAME])

The only difference with the C
is the RESULTS param wich is an array ref with
the expected results (order does not matter).

=cut

sub match_rule_array {
	my ($rule, $dir, $results, $name) = @_;
	$name ||= "Match the rule";

	my @files = $rule->in($dir);
	my $files_stringy = join '¨^¨', sort @files;
	my $results_stringy = join '¨^¨', sort @$results;
	if ($results_stringy eq $files_stringy) {
		$Test->ok(1, $name);
	} else {
		$Test->ok(0, $name);
		$Test->diag("Expected [".join(', ', sort @files)."]");
		$Test->diag("Got      [".join(', ', sort @$results)."]");
	}
}

1;

=back

=head1 SEE ALSO

L, L
L, L
L, L

=head1 AUTHOR

Fabien POTENCIER, [e-mail]

=head1 COPYRIGHT

Copyright 2003-2004, Fabien POTENCIER, All Rights Reserved

=head1 LICENSE

You may use, modify, and distribute this under the same terms
as Perl itself.

=cut