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


line stmt bran cond sub pod time code
1             package File::Find::Rule::LibMagic;
2              
3 1     1   21351 use warnings;
  1         2  
  1         29  
4 1     1   4 use strict;
  1         2  
  1         30  
5              
6 1     1   4 use base 'File::Find::Rule';
  1         5  
  1         1381  
7 1     1   8473 use File::LibMagic 0.96;
  0            
  0            
8             use Text::Glob qw(glob_to_regex);
9             use Params::Util qw(_ARRAY0 _REGEX);
10              
11             =head1 NAME
12              
13             File::Find::Rule::LibMagic - rule to match on file types or mime types
14              
15             =cut
16              
17             our $VERSION = '0.02';
18              
19              
20             =head1 SYNOPSIS
21              
22             use File::Find::Rule::LibMagic;
23              
24             my @executables = find( file => magic => '*executable*', in => $searchdir );
25             my @images = find( file => mime => 'image/*', in => $homepagebase );
26              
27             =head1 DESCRIPTION
28              
29             File::Find::Rule::LibMagic extends L by matching files
30             depending on their magic file type or MIME type delivered through
31             L from C UNIX command.
32              
33             Every UNIX user (or users of unix-like systems) knows the C command.
34             With this module files can be found depending on their file type from magic
35             database or their MIME type.
36              
37             It conflicts with L.
38              
39             =head1 EXPORT
40              
41             This module doesn't export any function. The provided functionality is called
42             by L according to the matching rules.
43              
44             =head1 SUBROUTINES/METHODS
45              
46             =head2 magic
47              
48             Accepts a list of strings or regular expressions which are approved to match
49             the result of L.
50              
51             =head2 mime
52              
53             Accepts a list of strings or regular expressions which are approved to match
54             the result of L.
55              
56             =cut
57              
58             sub File::Find::Rule::magic
59             {
60             my $self = shift;
61             local $Text::Glob::strict_wildcard_slash = 0; # allow '/opt/perl32/bin/perl script text executable'
62             my @args = defined( _ARRAY0( $_[0] ) ) ? @{$_[0]} : @_;
63             my @patterns = map { defined( _REGEX( $_ ) ) ? $_ : glob_to_regex $_ } @args;
64             my $lm = File::LibMagic->new();
65             $self->exec( sub {
66             my $type = $lm->describe_filename($_);
67             foreach my $pattern (@patterns) { return 1 if($type =~ m/$pattern/) }
68             return;
69             } );
70             }
71              
72             sub File::Find::Rule::mime
73             {
74             my $self = shift;
75             my @args = defined( _ARRAY0( $_[0] ) ) ? @{$_[0]} : @_;
76             my @patterns = map { defined( _REGEX( $_ ) ) ? $_ : glob_to_regex $_ } @args;
77             my $lm = File::LibMagic->new();
78             $self->exec( sub {
79             my $type = $lm->checktype_filename($_);
80             foreach my $pattern (@patterns) { return 1 if($type =~ m/$pattern/) }
81             return;
82             } );
83             }
84              
85             =head1 AUTHOR
86              
87             Jens Rehsack, C<< >>
88              
89             =head1 BUGS
90              
91             Please report any bugs or feature requests to C, or through
92             the web interface at L. I will be notified, and then you'll
93             automatically be notified of progress on your bug as I make changes.
94              
95              
96              
97              
98             =head1 SUPPORT
99              
100             You can find documentation for this module with the perldoc command.
101              
102             perldoc File::Find::Rule::LibMagic
103              
104              
105             You can also look for information at:
106              
107             =over 4
108              
109             =item * RT: CPAN's request tracker
110              
111             L
112              
113             =item * AnnoCPAN: Annotated CPAN documentation
114              
115             L
116              
117             =item * CPAN Ratings
118              
119             L
120              
121             =item * Search CPAN
122              
123             L
124              
125             =back
126              
127             =head1 LICENSE AND COPYRIGHT
128              
129             Copyright 2010 Jens Rehsack.
130              
131             This program is free software; you can redistribute it and/or modify it
132             under the terms of either: the GNU General Public License as published
133             by the Free Software Foundation; or the Artistic License.
134              
135             See http://dev.perl.org/licenses/ for more information.
136              
137             =cut
138              
139             1; # End of File::Find::Rule::LibMagic