File Coverage

blib/lib/AudioFile/Find.pm
Criterion Covered Total %
statement 41 49 83.6
branch 5 18 27.7
condition 1 2 50.0
subroutine 11 11 100.0
pod 3 4 75.0
total 61 84 72.6


line stmt bran cond sub pod time code
1             package AudioFile::Find;
2              
3 1     1   34628 use warnings;
  1         1  
  1         28  
4 1     1   3 use strict;
  1         1  
  1         21  
5              
6 1     1   536 use File::Find::Rule;
  1         6778  
  1         6  
7 1     1   497 use AudioFile::Info;
  1         6059  
  1         26  
8 1     1   454 use List::MoreUtils qw( zip );
  1         911  
  1         63  
9 1     1   10 use YAML 'LoadFile';
  1         1  
  1         460  
10              
11             =head1 NAME
12              
13             AudioFile::Find - Finds audio files located on your system and maps them to L objects.
14              
15             =cut
16              
17             our $VERSION = '0.03';
18             $VERSION = eval $VERSION;
19              
20             =head1 SYNOPSIS
21              
22             use AudioFile::Find;
23              
24             my $finder = AudioFile::Find->new( 'some/dir' );
25            
26             # find everything
27             my @audiofiles = $finder->search();
28            
29             # specify a search directory
30             my @audiofiles = $finder->search( 'some/other/dir' );
31            
32             #same for genre, title, track, artist and album
33             my @audiofiles = $finder->search( artist => 'Seeed' );
34            
35             #search using a regex
36             my @audiofiles = $finder->search( 'some/other/dir', title => qr/Ding/ );
37            
38             # anonymous subroutine that returns true or false
39             my @audiofiles = $finder->search( 'some/other/dir', track => sub { return shift > 10; } );
40              
41             =head1 METHODS
42              
43             =head2 new
44              
45             Creates an object of this class. Takes an optional single argument which is the directory to search in.
46              
47             =cut
48              
49             sub new {
50 3     3 1 5780 my ($class, $dir) = @_;
51 3         10 return bless { dir => $dir }, $class;
52             }
53              
54             =head2 new
55              
56             Sets and returns the directory to search.
57              
58             =cut
59              
60             sub dir {
61 1     1 0 172 my ($self, $dir) = @_;
62 1 50       3 $self->{dir} = $dir if defined $dir;
63 1         8 return $self->{dir};
64             }
65              
66             =head2 search
67              
68             Starts the search and returns a hash of filenames as keys and AudioFile::Info-Objects as values.
69             You may specify a search directory as the first argument
70             and also pass a hash with search criteria. See the synopsis for details.
71              
72             =cut
73              
74             sub search {
75 2     2 1 592 my $self = shift;
76 2 100       7 my $dir = @_ % 2 == 0 ? '' : shift;
77 2         4 my $args = {@_};
78 2         1 my %audio;
79            
80 2         4 my @patterns = map { "*.$_" } $self->extensions;
  2         12  
81 2   50     100 for ( File::Find::Rule->file()->name( @patterns )->in( $dir || $self->dir || '.' ) )
82             {
83 2         1251 my $info = AudioFile::Info->new($_);
84            
85 2 50       8 $audio{$_} = $info
86             if $self->pass( $info, $args);
87             }
88            
89 2         15 return %audio;
90             }
91              
92             =head2 pass
93              
94             Checks whether a given L object meets given criteria.
95             First argument is the L object, second argument is a reference to the criteria hash.
96              
97             =cut
98              
99             sub pass
100             {
101 2     2 1 3 my ($self, $file, $criteria) = @_;
102            
103 2         9 while ( my ($key, $criterium) = each %$criteria )
104             {
105 0         0 my $value = $file->$key;
106            
107 0 0       0 if ( ref($criterium) eq "Regexp" )
    0          
108             {
109 0 0       0 return unless $value =~ $criterium;
110             }
111             elsif ( ref($criterium) eq "CODE" )
112             {
113 0 0       0 return unless $criterium->( $value );
114             }
115             else
116             {
117 0 0       0 return unless $value eq $criterium;
118             }
119             }
120            
121 2         8 return 1;
122             }
123              
124             =head2 extensions
125              
126             Discovers the extensions that are supported by the installed L plugins.
127              
128             =cut
129              
130             sub extensions {
131 1     1   4 my ($self) = @_;
132 1         2 my $path = $INC{'AudioFile/Info.pm'};
133 1         5 $path =~ s/Info.pm$/plugins.yaml/;
134 1 50       2 my $config = eval { LoadFile($path) } or return;
  1         3  
135 0           my @ext = keys %{ $config->{default} };
  0            
136 0           return @ext;
137             }
138              
139             1;
140              
141             =head1 AUTHORS
142              
143             =over
144              
145             =item Markus, C<< >>
146              
147             =item Joel Berger C
148              
149             =back
150              
151             =head1 SOURCE REPOSITORY
152              
153             L
154              
155             =head1 BUGS
156              
157             Bugs may be reported to:
158              
159             =over
160              
161             =item L
162              
163             =item L
164              
165             =back
166              
167             =head1 COPYRIGHT & LICENSE
168              
169             Copyright 2008-2014 by Authors listed above, all rights reserved.
170              
171             This program is free software; you can redistribute it and/or modify it
172             under the same terms as Perl itself.
173              
174             =cut
175