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

Last change on this file since 12 was 12, checked in by peter, 18 years ago
  • added "exclude_path" option to Filesystem backend
  • added an excluded directory to the test suite ("t/dont_look_here")
  • fixed dying DB test (still a workaround for a DBD::SQLite problem)
File size: 3.4 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
12use_winamp_genres();
13
14sub search {
15    my $self = shift;
16    my ($query, $dirs, $sort, $options) = @_;
17   
18    # prep the search patterns as regexes
19    foreach (keys(%$query)) {
20        my $ref = ref $$query{$_};
21        # make arrays into 'OR' searches
22        if ($ref eq 'ARRAY') {
23            $$query{$_} = '(' . join('|', @{ $$query{$_} }) . ')';
24        }
25        # convert to a regex unless it already IS a regex       
26        unless ($ref eq 'Regexp') {
27            $$query{$_} = "^$$query{$_}\$" if $$options{exact_match};
28            $$query{$_} = $$options{ignore_case} ? qr[$$query{$_}]i : qr[$$query{$_}];
29        }
30    }
31   
32    if ($$options{exclude_path}) {
33        my $ref = ref $$options{exclude_path};
34        if ($ref eq 'ARRAY') {
35            $$options{exclude_path} = '(' . join('|', @{ $$options{exclude_path} }) . ')';
36        }
37        unless ($ref eq 'Regexp') {
38            $$options{exclude_path} = qr[$$options{exclude_path}];
39        }
40    }
41   
42    # run the actual find
43    my @results;
44    find(sub { match_mp3($File::Find::name, $query, \@results, $options) }, $_) foreach @$dirs;
45   
46    # sort the results
47    if (@$sort) {
48        @results = sort {
49            my $compare;
50            foreach (map { uc } @$sort) {
51                # use Scalar::Util to do the right sort of comparison
52                $compare = (looks_like_number($a->{$_}) && looks_like_number($b->{$_})) ?
53                    $a->{$_} <=> $b->{$_} :
54                    $a->{$_} cmp $b->{$_};
55                # we found a field they differ on
56                last if $compare;
57            }
58            return $compare;
59        } @results;
60    }
61   
62    return @results
63}
64
65sub match_mp3 {
66    my ($filename, $query, $results, $options) = @_;
67   
68    return unless $filename =~ m{[^/]\.mp3$};
69    if ($$options{exclude_path}) {
70        return if $filename =~ $$options{exclude_path};
71    }
72   
73    my $mp3 = {
74        FILENAME => $filename,
75        %{ get_mp3tag($filename)  || {} },
76        %{ get_mp3info($filename) || {} },
77    };
78    for my $field (keys(%{ $query })) {
79        my $value = $mp3->{uc($field)};
80        return unless defined $value;
81        return unless $value =~ $query->{$field};
82    }
83   
84    push @{ $results }, $mp3;
85}
86
87# module return
881;
89
90=head1 NAME
91
92MP3::Find::Filesystem - File::Find-based backend to MP3::Find
93
94=head1 SYNOPSIS
95
96    use MP3::Find::Filesystem;
97    my $finder = MP3::Find::Filesystem->new;
98   
99    my @mp3s = $finder->find_mp3s(
100        dir => '/home/peter/music',
101        query => {
102            artist => 'ilyaimy',
103            album  => 'myxomatosis',
104        },
105        ignore_case => 1,
106    );
107
108=head1 REQUIRES
109
110L<File::Find>, L<MP3::Info>, L<Scalar::Util>
111
112=head1 DESCRIPTION
113
114This module implements the C<search> method from L<MP3::Find::Base>
115using a L<File::Find> based search of the local filesystem.
116
117=head2 Special Options
118
119=over
120
121=item C<exclude_path>
122
123Scalar or arrayref; any file whose name matches any of these paths
124will be skipped.
125
126=head1 SEE ALSO
127
128L<MP3::Find>, L<MP3::Find::DB>
129
130=head1 AUTHOR
131
132Peter Eichman <peichman@cpan.org>
133
134=head1 COPYRIGHT AND LICENSE
135
136Copyright (c) 2006 by Peter Eichman. All rights reserved.
137
138This program is free software; you can redistribute it and/or
139modify it under the same terms as Perl itself.
140
141=cut
Note: See TracBrowser for help on using the repository browser.