File Coverage

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

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package File::Find::Rule::LibMagic;

use warnings;
use strict;

use base 'File::Find::Rule';
use File::LibMagic 0.96;
use Text::Glob qw(glob_to_regex);
use Params::Util qw(_ARRAY0 _REGEX);

=head1 NAME

File::Find::Rule::LibMagic - rule to match on file types or mime types

=cut

our $VERSION = '0.02';


=head1 SYNOPSIS

    use File::Find::Rule::LibMagic;

    my @executables = find( file => magic => '*executable*', in => $searchdir );
    my @images = find( file => mime => 'image/*', in => $homepagebase );

=head1 DESCRIPTION

File::Find::Rule::LibMagic extends L by matching files
depending on their magic file type or MIME type delivered through
L from C UNIX command.

Every UNIX user (or users of unix-like systems) knows the C command.
With this module files can be found depending on their file type from magic
database or their MIME type.

It conflicts with L.

=head1 EXPORT

This module doesn't export any function. The provided functionality is called
by L according to the matching rules.

=head1 SUBROUTINES/METHODS

=head2 magic

Accepts a list of strings or regular expressions which are approved to match
the result of L.

=head2 mime

Accepts a list of strings or regular expressions which are approved to match
the result of L.

=cut

sub File::Find::Rule::magic
{
    my $self = shift;
    local $Text::Glob::strict_wildcard_slash = 0; # allow '/opt/perl32/bin/perl script text executable'
    my @args = defined( _ARRAY0( $_[0] ) ) ? @{$_[0]} : @_;
    my @patterns = map { defined( _REGEX( $_ ) ) ? $_ : glob_to_regex $_ } @args;
    my $lm = File::LibMagic->new();
    $self->exec( sub {
                     my $type = $lm->describe_filename($_);
                     foreach my $pattern (@patterns) { return 1 if($type =~ m/$pattern/) }
                     return;
                 } );
}

sub File::Find::Rule::mime
{
    my $self = shift;
    my @args = defined( _ARRAY0( $_[0] ) ) ? @{$_[0]} : @_;
    my @patterns = map { defined( _REGEX( $_ ) ) ? $_ : glob_to_regex $_ } @args;
    my $lm = File::LibMagic->new();
    $self->exec( sub {
                     my $type = $lm->checktype_filename($_);
                     foreach my $pattern (@patterns) { return 1 if($type =~ m/$pattern/) }
                     return;
                 } );
}

=head1 AUTHOR

Jens Rehsack, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc File::Find::Rule::LibMagic


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2010 Jens Rehsack.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

1; # End of File::Find::Rule::LibMagic