source: mp3-find/trunk/lib/MP3/Find/Filesystem.pm @ 25

Last change on this file since 25 was 25, checked in by peter, 18 years ago
  • MP3::Find::Filesystem will warn if you ask to "use_id3v2" and MP3::Tag cannot be loaded
  • mp3find now searches ID3v2 tags be default
  • incremented version number
  • generated new README
File size: 5.0 KB
Line 
1package MP3::Find::Filesystem;
2
3use strict;
4use warnings;
5
6use base 'MP3::Find::Base';
7
8use File::Find;
9use MP3::Info;
10use Scalar::Util qw(looks_like_number);
11
12eval {
13    require Sort::Key;
14    Sort::Key->import(qw(multikeysorter));
15    use Sort::Key::Natural;
16};
17my $USE_SORT_KEY = $@ ? 0 : 1;
18
19use_winamp_genres();
20
21sub search {
22    my $self = shift;
23    my ($query, $dirs, $sort, $options) = @_;
24   
25    # prep the search patterns as regexes
26    foreach (keys(%$query)) {
27        my $ref = ref $$query{$_};
28        # make arrays into 'OR' searches
29        if ($ref eq 'ARRAY') {
30            $$query{$_} = '(' . join('|', @{ $$query{$_} }) . ')';
31        }
32        # convert to a regex unless it already IS a regex       
33        unless ($ref eq 'Regexp') {
34            $$query{$_} = "^$$query{$_}\$" if $$options{exact_match};
35            $$query{$_} = $$options{ignore_case} ? qr[$$query{$_}]i : qr[$$query{$_}];
36        }
37    }
38   
39    if ($$options{exclude_path}) {
40        my $ref = ref $$options{exclude_path};
41        if ($ref eq 'ARRAY') {
42            $$options{exclude_path} = '(' . join('|', @{ $$options{exclude_path} }) . ')';
43        }
44        unless ($ref eq 'Regexp') {
45            $$options{exclude_path} = qr[$$options{exclude_path}];
46        }
47    }
48   
49    # run the actual find
50    my @results;
51    find(sub { match_mp3($File::Find::name, $query, \@results, $options) }, $_) foreach @$dirs;
52   
53    # sort the results
54    if (@$sort) {
55        if ($USE_SORT_KEY) {
56            # use Sort::Key to do a (hopefully!) faster sort
57            #TODO: profile this; at first glance, it doesn't actually seem to be any faster
58            #warn "Using Sort::Key";
59            my $sorter = multikeysorter(
60                sub { my $info = $_; map { $info->{uc $_} } @$sort },
61                map { 'natural' } @$sort
62            );
63            @results = $sorter->(@results);
64        } else {
65            @results = sort {
66                my $compare;
67                foreach (map { uc } @$sort) {
68                    # use Scalar::Util to do the right sort of comparison
69                    $compare = (looks_like_number($a->{$_}) && looks_like_number($b->{$_})) ?
70                        $a->{$_} <=> $b->{$_} :
71                        $a->{$_} cmp $b->{$_};
72                    # we found a field they differ on
73                    last if $compare;
74                }
75                return $compare;
76            } @results;
77        }
78    }
79   
80    return @results
81}
82
83sub match_mp3 {
84    my ($filename, $query, $results, $options) = @_;
85   
86    return unless $filename =~ m{[^/]\.mp3$};
87    if ($$options{exclude_path}) {
88        return if $filename =~ $$options{exclude_path};
89    }
90   
91    my $mp3 = {
92        FILENAME => $filename,
93        %{ get_mp3tag($filename)  || {} },
94        %{ get_mp3info($filename) || {} },
95    };
96   
97    if ($$options{use_id3v2}) {
98        eval { require MP3::Tag };
99        if ($@) {
100            # we weren't able to load MP3::Tag!
101            warn "MP3::Tag is required to search ID3v2 tags";
102        } else {
103            # add ID3v2 tag info, if present
104            my $mp3_tags = MP3::Tag->new($filename);
105            $mp3_tags->get_tags;
106            if (my $id3v2 = $mp3_tags->{ID3v2}) {
107                for my $frame_id (keys %{ $id3v2->get_frame_ids }) {
108                    my ($info) = $id3v2->get_frame($frame_id);
109                    if (ref $info eq 'HASH') {
110                        #TODO: how should we handle these?
111                    } else {
112                        $mp3->{$frame_id} = $info;
113                    }
114                }
115            }
116        }
117    }
118
119    for my $field (keys(%{ $query })) {
120        my $value = $mp3->{uc($field)};
121        return unless defined $value;
122        return unless $value =~ $query->{$field};
123    }
124   
125    push @{ $results }, $mp3;
126}
127
128# module return
1291;
130
131=head1 NAME
132
133MP3::Find::Filesystem - File::Find-based backend to MP3::Find
134
135=head1 SYNOPSIS
136
137    use MP3::Find::Filesystem;
138    my $finder = MP3::Find::Filesystem->new;
139   
140    my @mp3s = $finder->find_mp3s(
141        dir => '/home/peter/music',
142        query => {
143            artist => 'ilyaimy',
144            album  => 'myxomatosis',
145        },
146        ignore_case => 1,
147    );
148
149=head1 REQUIRES
150
151L<File::Find>, L<MP3::Info>, L<Scalar::Util>
152
153L<MP3::Tag> is also needed if you want to search using ID3v2 tags.
154
155=head1 DESCRIPTION
156
157This module implements the C<search> method from L<MP3::Find::Base>
158using a L<File::Find> based search of the local filesystem.
159
160=head2 Special Options
161
162=over
163
164=item C<exclude_path>
165
166Scalar or arrayref; any file whose name matches any of these paths
167will be skipped.
168
169=item C<use_id3v2>
170
171Boolean, defaults to false. If set to true, MP3::Find::Filesystem will
172use L<MP3::Tag> to get the ID3v2 tag for each file. You can then search
173for files by their ID3v2 data, using the four-character frame names.
174This isn't very useful if you are just search by artist or title, but if,
175for example, you have made use of the C<TOPE> ("Orignal Performer") frame,
176you could search for all the cover songs in your collection:
177
178    $finder->find_mp3s(query => { tope => '.' });
179
180As with the basic query keys, ID3v2 query keys are converted to uppercase
181internally.
182
183=back
184
185=head1 SEE ALSO
186
187L<MP3::Find>, L<MP3::Find::DB>
188
189=head1 AUTHOR
190
191Peter Eichman <peichman@cpan.org>
192
193=head1 COPYRIGHT AND LICENSE
194
195Copyright (c) 2006 by Peter Eichman. All rights reserved.
196
197This program is free software; you can redistribute it and/or
198modify it under the same terms as Perl itself.
199
200=cut
Note: See TracBrowser for help on using the repository browser.