Index: /tags/0.05/Changes =================================================================== --- /tags/0.05/Changes (revision 26) +++ /tags/0.05/Changes (revision 26) @@ -0,0 +1,23 @@ +Revision history for Perl extension MP3::Find. + +0.05 28 Apr 2006 + - mp3find searches in ID3v2 tags if MP3::Tag is available + - using Sort::Key for sorting of results (if available) + +0.04 2 Apr 2006 + - BUGFIX: fixed tests that were failing because the test mp3 was not included + - added "status_callback" option to DB backend constructor + +0.03 27 Mar 2006 + - added "exclude_path" option to filesystem backend + - added "sync_db" method to the DB backend + - added support for searching by ID3v2 tag (using MP3::Tag) + +0.02 1 Feb 2006 + - doc updates to MP3::Find (thanks to Mike Slass for the suggestion) + - added a test suite for the DB backend + - DB management functions are now in the DB backend + - rewrote (and documented) mp3db to use the new DB backend functions + +0.01 29 Jan 2006 + - first CPAN release Index: /tags/0.05/MANIFEST =================================================================== --- /tags/0.05/MANIFEST (revision 26) +++ /tags/0.05/MANIFEST (revision 26) @@ -0,0 +1,17 @@ +Changes +Makefile.PL +MANIFEST +README +t/01.t +t/02-filesystem.t +t/03-db.t +t/mp3s/not-an-mp3 +t/mp3s/dont_look_here/testv2.4.0.mp3 +lib/MP3/Find.pm +lib/MP3/Find/Base.pm +lib/MP3/Find/Filesystem.pm +lib/MP3/Find/DB.pm +lib/MP3/Find/Util.pm +bin/mp3find +bin/mp3db +META.yml Module meta-data (added by MakeMaker) Index: /tags/0.05/Makefile.PL =================================================================== --- /tags/0.05/Makefile.PL (revision 26) +++ /tags/0.05/Makefile.PL (revision 26) @@ -0,0 +1,19 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + NAME => 'MP3::Find', + VERSION_FROM => 'lib/MP3/Find.pm', + PREREQ_PM => { + 'MP3::Info' => 0, + 'File::Find' => 0, + 'Scalar::Util' => 0, + }, + EXE_FILES => [qw( + bin/mp3find + bin/mp3db + )], + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'lib/MP3/Find.pm', # retrieve abstract from module + AUTHOR => 'Peter Eichman ') : ()), +); Index: /tags/0.05/README =================================================================== --- /tags/0.05/README (revision 26) +++ /tags/0.05/README (revision 26) @@ -0,0 +1,62 @@ +MP3::Find version 0.05 +====================== + +DESCRIPTION + This module allows you to search for MP3 files by their ID3 tags. You + can ask for the results to be sorted by one or more of those tags, and + return either the list of filenames (the deault), a "printf"-style + formatted string for each file using its ID3 tags, or the actual Perl + data structure representing the results. + + There are currently two backends to this module: MP3::Find::Filesystem + and MP3::Find::DB. You choose which one you want by passing its name as + the argument to you "use" statement; MP3::Find will look for a + MP3::Find::$BACKEND module. If no backend name is given, it will default + to using MP3::Find::Filesystem. + + Note: I'm still working out some kinks in the DB backend, so it is + currently not as stable as the Filesystem backend. + + Note the second: This whole project is still in the alpha stage, so I + can make no guarentees that there won't be significant interface changes + in the next few versions or so. Also, comments about what about the API + rocks (or sucks!) are appreciated. + +INSTALL + To install this module type the following: + + perl Makefile.PL + make + make test + make install + +SYNOPSIS + # select with backend you want + use MP3::Find qw(Filesystem); + + print "$_\n" foreach find_mp3s( + dir => '/home/peter/cds', + query => { + artist => 'ilyaimy', + title => 'deep in the am', + }, + ignore_case => 1, + exact_match => 1, + sort => [qw(year album tracknum)], + printf => '%2n. %a - %t (%b: %y)', + ); + +REQUIRES + File::Find, MP3::Info, and Scalar::Util are needed for the filesystem + backend (MP3::Find::Filesystem). In addition, if MP3::Tag is available, + you can search by explicit ID3v2 tag frames. + + DBI, DBD::SQLite, and SQL::Abstract are needed for the database backend + (MP3::Find::DB). + +COPYRIGHT AND LICENSE + Copyright (c) 2006 by Peter Eichman. All rights reserved. + + This program is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. + Index: /tags/0.05/bin/cql =================================================================== --- /tags/0.05/bin/cql (revision 26) +++ /tags/0.05/bin/cql (revision 26) @@ -0,0 +1,30 @@ +#!/usr/bin/perl -w +use strict; + +package MyVisitor; +use base qw( CQL::Visitor ); + +sub term { + my ($self,$node) = @_; + # do something to the node + print $node->{qualifier}, " ", $node->{term}, "\n"; +} + +package main; + +use CQL::Parser; +use YAML; + +my $p = CQL::Parser->new; + +my $cql = <parse($cql); + +#print Dump($root); + +my $visitor = MyVisitor->new; +$visitor->visit($root); + Index: /tags/0.05/bin/mp3db =================================================================== --- /tags/0.05/bin/mp3db (revision 26) +++ /tags/0.05/bin/mp3db (revision 26) @@ -0,0 +1,68 @@ +#!/usr/bin/perl -w +use strict; + +use MP3::Find::DB; + +use File::Spec::Functions qw(catfile); +use Getopt::Long; +GetOptions( + 'create' => \my $CREATE, + 'file|f=s' => \my $DB_FILE, +); + +$DB_FILE ||= catfile($ENV{HOME}, 'mp3.db'); + +my @DIRS = @ARGV; + +my $f = MP3::Find::DB->new; +$f->create_db($DB_FILE) if $CREATE; +$f->update_db($DB_FILE, \@DIRS) if @DIRS; + +=head1 NAME + +mp3db - Frontend for creating and updating a database for MP3::Find::DB + +=head1 SYNOPSIS + + # create the database file + $ mp3db --create --file my_mp3.db + + # add info + $ mp3db --file my_mp3.db ~/mp3 + + # update, and add results from another directory + $ mp3db --file my_mp3.db ~/mp3 ~/cds + +=head1 DESCRIPTION + + mp3db [options] [directory] [directories...] + +Creates and/or updates a database of ID3 data from the mp3s found +in the given directories. + +=head2 Options + +=over + +=item C<--create>, C<-c> + +Create the database file named by the C<--file> option. + +=item C<--file>, C<-f> + +The name of the database file to work with. Defaults to F<~/mp3.db>. + +=back + +=head1 AUTHOR + +Peter Eichman + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2006 by Peter Eichman. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut Index: /tags/0.05/bin/mp3find =================================================================== --- /tags/0.05/bin/mp3find (revision 26) +++ /tags/0.05/bin/mp3find (revision 26) @@ -0,0 +1,123 @@ +#!/usr/bin/perl -w +use strict; + +use Getopt::Long qw(:config pass_through); # use pass_through so we can get the query args + +use MP3::Find qw(Filesystem); +use MP3::Find::Util qw(build_query); +use File::Spec::Functions qw(catfile); + +GetOptions( + 'ignore-case|i' => \my $IGNORE_CASE, + 'exact-match|w' => \my $EXACT_MATCH, + 'sort|s=s' => \my $SORT_TAG, + 'printf=s' => \my $FORMAT, +); + +my ($DIRS, $QUERY) = build_query(@ARGV); +push @$DIRS, '.' unless @$DIRS; + +print "$_\n" foreach find_mp3s( + dir => $DIRS, + query => $QUERY, + ignore_case => $IGNORE_CASE, + exact_match => $EXACT_MATCH, + ($SORT_TAG ? (sort => [split(/,/, $SORT_TAG)]) : ()), + printf => $FORMAT, + db_file => catfile($ENV{HOME}, 'mp3.db'), + use_id3v2 => 1, # search using ID3v2 tags by default +); + +=head1 NAME + +mp3find - Find MP3 files based on their ID3 tags or info + +=head1 SYNOPSIS + + $ mp3find ~/cds -i -artist beatles -sort year,album,tracknum -printf '%2n. %a - %t (%b: %y)' + 1. The Beatles - Magical Mystery Tour (Magical Mystery Tour: 1967) + 2. The Beatles - The Fool on the Hill (Magical Mystery Tour: 1967) + 3. The Beatles - Flying (Magical Mystery Tour: 1967) + 4. The Beatles - Blue Jay Way (Magical Mystery Tour: 1967) + 5. The Beatles - Your Mother Should Know (Magical Mystery Tour: 1967) + 6. The Beatles - I Am The Walrus (Magical Mystery Tour: 1967) + # etc. + + # shuffle and play your entire mp3 collection + $ mp3find | xargs madplay -z + + # ...or just your Sabbath + $ mp3find -i -artist 'black sabbath' | xargs madplay -z + +=head1 DESCRIPTION + + $ mp3find [options] [directory] [<-field> [<-field> ...]] + +The real guts of the operation are in L. + +=head2 OPTIONS + +=over + +=item C<-ignore-case>, C<-i> + +Case insensitive matching. + +=item C<-exact-match>, C<-w> + +All search patterns must match the entire value, and not just a +substring. This has the same effect as putting a C<^> and C<$> +around each pattern. + +=item C<-2> + +Lets you give ID3v2 frame ids as search fields. For instance, to +find everything which has been tagged as having an "Original artist" +(i.e., It's probably a cover song): + + mp3find ~/music -tope . + +=item C<-sort> + +Which ID3 fields to sort the results by; separate multiple fields +with commas. The default behavior just returns the filenames in the +order that L finds them. + +=item C<-printf> + +The output format for each file found. The available format codes are: + + %a - artist + %t - title + %b - album + %n - track number + %y - year + %g - genre + %% - literal '%' + +Numeric modifiers may be used; they are interpreted like modifiers to +the C<%s> code in Perl's C function. + +If no C<-printf> option is used, the full path to the file is printed +instead. + +=item C<< - [patterns...] >> + +The fields you are searching on. More than one pattern for a given field +are combined with 'OR', while the fields to be matched are 'AND'-ed together. +For the list of recognized fields, see L. + +=back + +=head1 AUTHOR + +Peter Eichman + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2006 by Peter Eichman. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut Index: /tags/0.05/bin/tagger =================================================================== --- /tags/0.05/bin/tagger (revision 26) +++ /tags/0.05/bin/tagger (revision 26) @@ -0,0 +1,30 @@ +#!/usr/bin/perl -w +use strict; + +use lib '/home/peter/projects/mp3-find/lib'; +use MP3::Find qw(Filesystem); +use MP3::Find::Util qw(build_query); +use File::Spec::Functions qw(catfile); + +use Term::ReadKey; + +my ($DIRS, $QUERY) = build_query(@ARGV); +push @$DIRS, '.' unless @$DIRS; + +for my $mp3 (find_mp3s( + dir => $DIRS, + query => $QUERY, + ignore_case => 1, #$IGNORE_CASE, + exact_match => 0, #$EXACT_MATCH, + no_format => 1, + db_file => catfile($ENV{HOME}, 'mp3.db'), +)) { + print "$$mp3{FILENAME}\n"; + my $i; + for (qw(ARTIST TITLE ALBUM YEAR GENRE)) { + printf "[%d] %-6s %s\n", ++$i, $_, $$mp3{$_}; + } + print "Change [1-5]? "; + my $key = ReadKey(0); +} + Index: /tags/0.05/lib/MP3/Find.pm =================================================================== --- /tags/0.05/lib/MP3/Find.pm (revision 26) +++ /tags/0.05/lib/MP3/Find.pm (revision 26) @@ -0,0 +1,210 @@ +package MP3::Find; + +use strict; +use warnings; + +use base qw(Exporter); +use vars qw($VERSION @EXPORT); + +use Carp; + +$VERSION = '0.05'; + +@EXPORT = qw(find_mp3s); + +my $finder; +sub import { + my $calling_pkg = shift; + # default to a filesystem search + my $finder_type = shift || 'Filesystem'; + my $package = "MP3::Find::$finder_type"; + eval "require $package"; + croak $@ if $@; + $finder = $package->new; + __PACKAGE__->export_to_level(1, @EXPORT); +} + +sub find_mp3s { $finder->find_mp3s(@_) } + + +# module return +1; + +=head1 NAME + +MP3::Find - Search and sort MP3 files based on their ID3 tags + +=head1 SYNOPSIS + + # select with backend you want + use MP3::Find qw(Filesystem); + + print "$_\n" foreach find_mp3s( + dir => '/home/peter/cds', + query => { + artist => 'ilyaimy', + title => 'deep in the am', + }, + ignore_case => 1, + exact_match => 1, + sort => [qw(year album tracknum)], + printf => '%2n. %a - %t (%b: %y)', + ); + +=head1 DESCRIPTION + +This module allows you to search for MP3 files by their ID3 tags. +You can ask for the results to be sorted by one or more of those +tags, and return either the list of filenames (the deault), a +C-style formatted string for each file using its ID3 tags, +or the actual Perl data structure representing the results. + +There are currently two backends to this module: L +and L. You choose which one you want by passing its +name as the argument to you C statement; B will look for +a B module. If no backend name is given, it will +default to using L. + +B I'm still working out some kinks in the DB backend, so it +is currently not as stable as the Filesystem backend. + +B: This whole project is still in the alpha stage, so +I can make no guarentees that there won't be significant interface changes +in the next few versions or so. Also, comments about what about the API +rocks (or sucks!) are appreciated. + +=head1 REQUIRES + +L, L, and L are needed for +the filesystem backend (L). In addition, +if L is available, you can search by explicit ID3v2 +tag frames. + +L, L, and L are needed for the +database backend (L). + +=head1 EXPORTS + +=head2 find_mp3s + + my @results = find_mp3s(%options); + +Takes the following options: + +=over + +=item C + +Arrayref or scalar; tell C where to start the search. +Directories in the arrayref are searched sequentially. + +=item C + +Hashref of search parameters. Recognized fields are anything that +L knows about. Field names can be given in either upper +or lower case; C will convert them into upper case for +you. Value may either be strings, which are converted into regular +exporessions, or may be C regular expressions already. + +=item C + +Boolean, default false; set to a true value to ignore case when +matching search strings to the ID3 tag values. + +=item C + +Boolean, default false; set to a true value to add an implicit +C<^> and C<$> around each query string. Does nothing if the query +term is already a regular expression. + +=item C + +What field or fields to sort the results by. Can either be a single +scalar field name to sort by, or an arrayref of field names. Again, +acceptable field names are anything that L knows about; +field names will be converted to upper case as with the C +option. + +=item C + +By default, C just returns the list of filenames. The +C option allows you to provide a formatting string to apply +to the data for each file. The style is roughly similar to Perl's +C format strings. The following formatting codes are +recognized: + + %a - artist + %t - title + %b - album + %n - track number + %y - year + %g - genre + %% - literal '%' + +Numeric modifers may be used in the same manner as with C<%s> in +Perl's C. + +=item C + +Boolean, default false; set to a true value to have C to +return an array of hashrefs instead of an array of (formatted) strings. +Each hashref consists of the key-value pairs from C +and C, plus the key C (with the obvious +value ;-) + + @results = ( + { + FILENAME => ..., + TITLE => ..., + ARTIST => ..., + ... + SECS => ..., + BITRATE => ..., + ... + }, + ... + ); + +=back + +=head1 BUGS + +There are probably some in there; let me know if you find any (patches +welcome). + +=head1 TODO + +Better tests, using some actual sample mp3 files. + +Other backends (a caching filesystem backend, perhaps?) + +=head1 SEE ALSO + +L, L + +L is the command line frontend to this module (it +currently only uses the filesystem backend). + +L is a (currently rather barebones) command line +frontend for creating and updating a SQLite database for +use with L. + +See L for more information about the fields you can +search and sort on. See L for information about +ID3v2 tags. + +L is another way to search for MP3 +files based on their ID3 tags. + +=head1 AUTHOR + +Peter Eichman + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2006 by Peter Eichman. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut Index: /tags/0.05/lib/MP3/Find/Base.pm =================================================================== --- /tags/0.05/lib/MP3/Find/Base.pm (revision 26) +++ /tags/0.05/lib/MP3/Find/Base.pm (revision 26) @@ -0,0 +1,206 @@ +package MP3::Find::Base; + +use strict; +use warnings; + +use Carp; + +my %format_codes = ( + a => 'ARTIST', + t => 'TITLE', + b => 'ALBUM', + n => 'TRACKNUM', + y => 'YEAR', + g => 'GENRE', +); + +sub new { + my $invocant = shift; + my $class = ref $invocant || $invocant; + my %options = @_; + my $self = \%options; + bless $self, $class; +} + +sub find_mp3s { + my $self = shift; + my %opt = @_; + + my $dir = $opt{dir} || $ENV{HOME}; + my @DIRS = ref $dir eq 'ARRAY' ? @$dir : ($dir); + + my %QUERY = %{ $opt{query} || {} }; + + # array ref for multiple sort fields, but allow + # a simple scalar for single values + my @SORT = $opt{sort} ? + (ref $opt{sort} eq 'ARRAY' ? @{ $opt{sort} } : ($opt{sort})) : + (); + + foreach (keys %QUERY) { + if (defined $QUERY{$_}) { + # package everything uniformly, so subclasses don't need to unpack it + $QUERY{$_} = [ $QUERY{$_} ] unless ref $QUERY{$_} eq 'ARRAY'; + } else { + # so we don't have spurious warnings when trying to match against undef + delete $QUERY{$_}; + } + } + + # do the search + my @results = $self->search(\%QUERY, \@DIRS, \@SORT, \%opt); + + # maybe they want the unformatted data + return @results if $opt{no_format}; + + if ($opt{printf}) { + # printf style output format + foreach (@results) { + my $output = $opt{printf}; + for my $code (keys %format_codes) { + + while ($output =~ m/%((-\d)?\d*)$code/g) { + # field size modifier + my $modifier = $1 || ''; + # figure out the size of the formating code + my $code_size = 2 + length($modifier); + my $value = sprintf("%${modifier}s", $_->{$format_codes{$code}} || ''); + substr($output, pos($output) - $code_size, $code_size, $value); + } + } + # to allow literal '%' + $output =~ s/%%/%/g; + $_ = $output; + } + } else { + # just the filenames, please + @results = map { $_->{FILENAME} } @results; + } + + return @results; +} + +sub search { + croak "Method 'search' not implemented in " . __PACKAGE__; +} + +# module return +1; + +=head1 NAME + +MP3::Find::Base - Base class for MP3::Find backends + +=head1 SYNOPSIS + + package MyFinder; + use base 'MP3::Find::Base'; + + sub search { + my $self = shift; + my ($query, $dirs, $sort, $options) = @_; + + # do something to find and sort the mp3s... + my @results = do_something(...); + + return @results; + } + + package main; + my $finder = MyFinder->new; + + # see MP3::Find for details about %options + print "$_\n" foreach $finder->find_mp3s(\%options); + +=head1 DESCRIPTION + +This is the base class for the classes that actually do the +searching and sorting for L. + +=head1 METHODS + +=head2 new + +Really simple constructor. If you pass it a hash of options, it +will hang on to them for you. + +=head2 search + +This is the one you should override in your subclass. If you +don't, the base class C method will croak. + +The C method is called by the C method with +the following arguments: the finder object, a hashref of query +parameters, an arrayref of directories to search, and a hashref +of miscellaneous options. + +The search method should return a list of hashrefs representing +the results of the search. Each hashref should have the following +keys (all except C are derived from the keys returned +by the C and C functions from L): + + FILENAME + + TITLE + ARTIST + ALBUM + YEAR + COMMENT + GENRE + TRACKNUM + + VERSION -- MPEG audio version (1, 2, 2.5) + LAYER -- MPEG layer description (1, 2, 3) + STEREO -- boolean for audio is in stereo + + VBR -- boolean for variable bitrate + BITRATE -- bitrate in kbps (average for VBR files) + FREQUENCY -- frequency in kHz + SIZE -- bytes in audio stream + OFFSET -- bytes offset that stream begins + + SECS -- total seconds + MM -- minutes + SS -- leftover seconds + MS -- leftover milliseconds + TIME -- time in MM:SS + + COPYRIGHT -- boolean for audio is copyrighted + PADDING -- boolean for MP3 frames are padded + MODE -- channel mode (0 = stereo, 1 = joint stereo, + -- 2 = dual channel, 3 = single channel) + FRAMES -- approximate number of frames + FRAME_LENGTH -- approximate length of a frame + VBR_SCALE -- VBR scale from VBR header + + +=head2 find_mp3s + +The method that should be called by the program doing the searching. + +See L for an explanation of the options that can be passed +to C. + +=head1 TODO + +More format codes? Possibly look into using L + +=head1 SEE ALSO + +L, L, L + +See L for more information about the fields you can +search and sort on. + +=head1 AUTHOR + +Peter Eichman + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2006 by Peter Eichman. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut Index: /tags/0.05/lib/MP3/Find/DB.pm =================================================================== --- /tags/0.05/lib/MP3/Find/DB.pm (revision 26) +++ /tags/0.05/lib/MP3/Find/DB.pm (revision 26) @@ -0,0 +1,351 @@ +package MP3::Find::DB; + +use strict; +use warnings; + +use base qw(MP3::Find::Base); +use Carp; + +use DBI; +use SQL::Abstract; + +my $sql = SQL::Abstract->new; + +my @COLUMNS = ( + [ mtime => 'INTEGER' ], # the filesystem mtime, so we can do incremental updates + [ FILENAME => 'TEXT' ], + [ TITLE => 'TEXT' ], + [ ARTIST => 'TEXT' ], + [ ALBUM => 'TEXT' ], + [ YEAR => 'INTEGER' ], + [ COMMENT => 'TEXT' ], + [ GENRE => 'TEXT' ], + [ TRACKNUM => 'INTEGER' ], + [ VERSION => 'NUMERIC' ], + [ LAYER => 'INTEGER' ], + [ STEREO => 'TEXT' ], + [ VBR => 'TEXT' ], + [ BITRATE => 'INTEGER' ], + [ FREQUENCY => 'INTEGER' ], + [ SIZE => 'INTEGER' ], + [ OFFSET => 'INTEGER' ], + [ SECS => 'INTEGER' ], + [ MM => 'INTEGER' ], + [ SS => 'INTEGER' ], + [ MS => 'INTEGER' ], + [ TIME => 'TEXT' ], + [ COPYRIGHT => 'TEXT' ], + [ PADDING => 'INTEGER' ], + [ MODE => 'INTEGER' ], + [ FRAMES => 'INTEGER' ], + [ FRAME_LENGTH => 'INTEGER' ], + [ VBR_SCALE => 'INTEGER' ], +); + +my $DEFAULT_STATUS_CALLBACK = sub { + my ($action_code, $filename) = @_; + print STDERR "$action_code $filename\n"; +}; + +sub search { + my $self = shift; + my ($query, $dirs, $sort, $options) = @_; + + croak 'Need a database name to search (set "db_file" in the call to find_mp3s)' unless $$options{db_file}; + + my $dbh = DBI->connect("dbi:SQLite:dbname=$$options{db_file}", '', '', {RaiseError => 1}); + + # use the 'LIKE' operator to ignore case + my $op = $$options{ignore_case} ? 'LIKE' : '='; + + # add the SQL '%' wildcard to match substrings + unless ($$options{exact_match}) { + for my $value (values %$query) { + $value = [ map { "%$_%" } @$value ]; + } + } + + my ($where, @bind) = $sql->where( + { map { $_ => { $op => $query->{$_} } } keys %$query }, + ( @$sort ? [ map { uc } @$sort ] : () ), + ); + + my $select = "SELECT * FROM mp3 $where"; + + my $sth = $dbh->prepare($select); + $sth->execute(@bind); + + my @results; + while (my $row = $sth->fetchrow_hashref) { + push @results, $row; + } + + return @results; +} + +sub create_db { + my $self = shift; + my $db_file = shift or croak "Need a name for the database I'm about to create"; + my $dbh = DBI->connect("dbi:SQLite:dbname=$db_file", '', '', {RaiseError => 1}); + $dbh->do('CREATE TABLE mp3 (' . join(',', map { "$$_[0] $$_[1]" } @COLUMNS) . ')'); +} + +sub update_db { + my $self = shift; + my $db_file = shift or croak "Need the name of the database to update"; + my $dirs = shift; + + my $status_callback = $self->{status_callback} || $DEFAULT_STATUS_CALLBACK; + + my @dirs = ref $dirs eq 'ARRAY' ? @$dirs : ($dirs); + + my $dbh = DBI->connect("dbi:SQLite:dbname=$db_file", '', '', {RaiseError => 1}); + my $mtime_sth = $dbh->prepare('SELECT mtime FROM mp3 WHERE FILENAME = ?'); + my $insert_sth = $dbh->prepare( + 'INSERT INTO mp3 (' . + join(',', map { $$_[0] } @COLUMNS) . + ') VALUES (' . + join(',', map { '?' } @COLUMNS) . + ')' + ); + my $update_sth = $dbh->prepare( + 'UPDATE mp3 SET ' . + join(',', map { "$$_[0] = ?" } @COLUMNS) . + ' WHERE FILENAME = ?' + ); + + # the number of records added or updated + my $count = 0; + + # look for mp3s using the filesystem backend + require MP3::Find::Filesystem; + my $finder = MP3::Find::Filesystem->new; + for my $mp3 ($finder->find_mp3s(dir => \@dirs, no_format => 1)) { + # see if the file has been modified since it was first put into the db + $mp3->{mtime} = (stat($mp3->{FILENAME}))[9]; + $mtime_sth->execute($mp3->{FILENAME}); + my $records = $mtime_sth->fetchall_arrayref; + + warn "Multiple records for $$mp3{FILENAME}\n" if @$records > 1; + + #TODO: maybe print status updates somewhere else? + if (@$records == 0) { + $insert_sth->execute(map { $mp3->{$$_[0]} } @COLUMNS); + $status_callback->(A => $$mp3{FILENAME}); + $count++; + } elsif ($mp3->{mtime} > $$records[0][0]) { + # the mp3 file is newer than its record + $update_sth->execute((map { $mp3->{$$_[0]} } @COLUMNS), $mp3->{FILENAME}); + $status_callback->(U => $$mp3{FILENAME}); + $count++; + } + } + + # as a workaround for the 'closing dbh with active staement handles warning + # (see http://rt.cpan.org/Ticket/Display.html?id=9643#txn-120724) + foreach ($mtime_sth, $insert_sth, $update_sth) { + $_->{RaiseError} = 0; # don't die on error + $_->{PrintError} = 0; # ...and don't even say anything + $_->{Active} = 1; + $_->finish; + } + + return $count; +} + +sub sync_db { + my $self = shift; + my $db_file = shift or croak "Need the name of the databse to sync"; + + my $status_callback = $self->{status_callback} || $DEFAULT_STATUS_CALLBACK; + + my $dbh = DBI->connect("dbi:SQLite:dbname=$db_file", '', '', {RaiseError => 1}); + my $select_sth = $dbh->prepare('SELECT FILENAME FROM mp3'); + my $delete_sth = $dbh->prepare('DELETE FROM mp3 WHERE FILENAME = ?'); + + # the number of records removed + my $count = 0; + + $select_sth->execute; + while (my ($filename) = $select_sth->fetchrow_array) { + unless (-e $filename) { + $delete_sth->execute($filename); + $status_callback->(D => $filename); + $count++; + } + } + + return $count; +} + +sub destroy_db { + my $self = shift; + my $db_file = shift or croak "Need the name of a database to destory"; + unlink $db_file; +} + +# module return +1; + +=head1 NAME + +MP3::Find::DB - SQLite database backend to MP3::Find + +=head1 SYNOPSIS + + use MP3::Find::DB; + my $finder = MP3::Find::DB->new; + + my @mp3s = $finder->find_mp3s( + dir => '/home/peter/music', + query => { + artist => 'ilyaimy', + album => 'myxomatosis', + }, + ignore_case => 1, + db_file => 'mp3.db', + ); + + # you can do things besides just searching the database + + # create another database + $finder->create_db('my_mp3s.db'); + + # update the database from the filesystem + $finder->update_db('my_mp3s.db', ['/home/peter/mp3', '/home/peter/cds']); + + # and then blow it away + $finder->destroy_db('my_mp3s.db'); + +=head1 REQUIRES + +L, L, L + +=head1 DESCRIPTION + +This is the SQLite database backend for L. + +B I'm still working out some kinks in here, so this backend +is currently not as stable as the Filesystem backend. + +=head2 Special Options + +=over + +=item C + +The name of the SQLite database file to use. Defaults to F<~/mp3.db>. + +The database should have at least one table named C with the +following schema: + + CREATE TABLE mp3 ( + mtime INTEGER, + FILENAME TEXT, + TITLE TEXT, + ARTIST TEXT, + ALBUM TEXT, + YEAR INTEGER, + COMMENT TEXT, + GENRE TEXT, + TRACKNUM INTEGER, + VERSION NUMERIC, + LAYER INTEGER, + STEREO TEXT, + VBR TEXT, + BITRATE INTEGER, + FREQUENCY INTEGER, + SIZE INTEGER, + OFFSET INTEGER, + SECS INTEGER, + MM INTEGER, + SS INTEGER, + MS INTEGER, + TIME TEXT, + COPYRIGHT TEXT, + PADDING INTEGER, + MODE INTEGER, + FRAMES INTEGER, + FRAME_LENGTH INTEGER, + VBR_SCALE INTEGER + ); + +=back + +=head1 METHODS + +=head2 new + + my $finder = MP3::Find::DB->new( + status_callback => \&callback, + ); + +The C gets called each time an entry in the +database is added, updated, or deleted by the C and +C methods. The arguments passed to the callback are +a status code (A, U, or D) and the filename for that entry. +The default callback just prints these to C: + + sub default_callback { + my ($status_code, $filename) = @_; + print STDERR "$status_code $filename\n"; + } + +To suppress any output, set C to an empty sub: + + status_callback => sub {} + +=head2 create_db + + $finder->create_db($db_filename); + +Creates a SQLite database in the file named c<$db_filename>. + +=head2 update_db + + my $count = $finder->update_db($db_filename, \@dirs); + +Searches for all mp3 files in the directories named by C<@dirs> +using L, and adds or updates the ID3 info +from those files to the database. If a file already has a record +in the database, then it will only be updated if it has been modified +sinc ethe last time C was run. + +=head2 sync_db + + my $count = $finder->sync_db($db_filename); + +Removes entries from the database that refer to files that no longer +exist in the filesystem. Returns the count of how many records were +removed. + +=head2 destroy_db + + $finder->destroy_db($db_filename); + +Permanantly removes the database. + +=head1 TODO + +Database maintanence routines (e.g. clear out old entries) + +Allow the passing of a DSN or an already created C<$dbh> instead +of a SQLite database filename; or write driver classes to handle +database dependent tasks (create_db/destroy_db). + +=head1 SEE ALSO + +L, L, L + +=head1 AUTHOR + +Peter Eichman + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2006 by Peter Eichman. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut Index: /tags/0.05/lib/MP3/Find/Filesystem.pm =================================================================== --- /tags/0.05/lib/MP3/Find/Filesystem.pm (revision 26) +++ /tags/0.05/lib/MP3/Find/Filesystem.pm (revision 26) @@ -0,0 +1,200 @@ +package MP3::Find::Filesystem; + +use strict; +use warnings; + +use base 'MP3::Find::Base'; + +use File::Find; +use MP3::Info; +use Scalar::Util qw(looks_like_number); + +eval { + require Sort::Key; + Sort::Key->import(qw(multikeysorter)); + use Sort::Key::Natural; +}; +my $USE_SORT_KEY = $@ ? 0 : 1; + +use_winamp_genres(); + +sub search { + my $self = shift; + my ($query, $dirs, $sort, $options) = @_; + + # prep the search patterns as regexes + foreach (keys(%$query)) { + my $ref = ref $$query{$_}; + # make arrays into 'OR' searches + if ($ref eq 'ARRAY') { + $$query{$_} = '(' . join('|', @{ $$query{$_} }) . ')'; + } + # convert to a regex unless it already IS a regex + unless ($ref eq 'Regexp') { + $$query{$_} = "^$$query{$_}\$" if $$options{exact_match}; + $$query{$_} = $$options{ignore_case} ? qr[$$query{$_}]i : qr[$$query{$_}]; + } + } + + if ($$options{exclude_path}) { + my $ref = ref $$options{exclude_path}; + if ($ref eq 'ARRAY') { + $$options{exclude_path} = '(' . join('|', @{ $$options{exclude_path} }) . ')'; + } + unless ($ref eq 'Regexp') { + $$options{exclude_path} = qr[$$options{exclude_path}]; + } + } + + # run the actual find + my @results; + find(sub { match_mp3($File::Find::name, $query, \@results, $options) }, $_) foreach @$dirs; + + # sort the results + if (@$sort) { + if ($USE_SORT_KEY) { + # use Sort::Key to do a (hopefully!) faster sort + #TODO: profile this; at first glance, it doesn't actually seem to be any faster + #warn "Using Sort::Key"; + my $sorter = multikeysorter( + sub { my $info = $_; map { $info->{uc $_} } @$sort }, + map { 'natural' } @$sort + ); + @results = $sorter->(@results); + } else { + @results = sort { + my $compare; + foreach (map { uc } @$sort) { + # use Scalar::Util to do the right sort of comparison + $compare = (looks_like_number($a->{$_}) && looks_like_number($b->{$_})) ? + $a->{$_} <=> $b->{$_} : + $a->{$_} cmp $b->{$_}; + # we found a field they differ on + last if $compare; + } + return $compare; + } @results; + } + } + + return @results +} + +sub match_mp3 { + my ($filename, $query, $results, $options) = @_; + + return unless $filename =~ m{[^/]\.mp3$}; + if ($$options{exclude_path}) { + return if $filename =~ $$options{exclude_path}; + } + + my $mp3 = { + FILENAME => $filename, + %{ get_mp3tag($filename) || {} }, + %{ get_mp3info($filename) || {} }, + }; + + if ($$options{use_id3v2}) { + eval { require MP3::Tag }; + if ($@) { + # we weren't able to load MP3::Tag! + warn "MP3::Tag is required to search ID3v2 tags"; + } else { + # add ID3v2 tag info, if present + my $mp3_tags = MP3::Tag->new($filename); + $mp3_tags->get_tags; + if (my $id3v2 = $mp3_tags->{ID3v2}) { + for my $frame_id (keys %{ $id3v2->get_frame_ids }) { + my ($info) = $id3v2->get_frame($frame_id); + if (ref $info eq 'HASH') { + #TODO: how should we handle these? + } else { + $mp3->{$frame_id} = $info; + } + } + } + } + } + + for my $field (keys(%{ $query })) { + my $value = $mp3->{uc($field)}; + return unless defined $value; + return unless $value =~ $query->{$field}; + } + + push @{ $results }, $mp3; +} + +# module return +1; + +=head1 NAME + +MP3::Find::Filesystem - File::Find-based backend to MP3::Find + +=head1 SYNOPSIS + + use MP3::Find::Filesystem; + my $finder = MP3::Find::Filesystem->new; + + my @mp3s = $finder->find_mp3s( + dir => '/home/peter/music', + query => { + artist => 'ilyaimy', + album => 'myxomatosis', + }, + ignore_case => 1, + ); + +=head1 REQUIRES + +L, L, L + +L is also needed if you want to search using ID3v2 tags. + +=head1 DESCRIPTION + +This module implements the C method from L +using a L based search of the local filesystem. + +=head2 Special Options + +=over + +=item C + +Scalar or arrayref; any file whose name matches any of these paths +will be skipped. + +=item C + +Boolean, defaults to false. If set to true, MP3::Find::Filesystem will +use L to get the ID3v2 tag for each file. You can then search +for files by their ID3v2 data, using the four-character frame names. +This isn't very useful if you are just search by artist or title, but if, +for example, you have made use of the C ("Orignal Performer") frame, +you could search for all the cover songs in your collection: + + $finder->find_mp3s(query => { tope => '.' }); + +As with the basic query keys, ID3v2 query keys are converted to uppercase +internally. + +=back + +=head1 SEE ALSO + +L, L + +=head1 AUTHOR + +Peter Eichman + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2006 by Peter Eichman. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut Index: /tags/0.05/lib/MP3/Find/Util.pm =================================================================== --- /tags/0.05/lib/MP3/Find/Util.pm (revision 26) +++ /tags/0.05/lib/MP3/Find/Util.pm (revision 26) @@ -0,0 +1,41 @@ +package MP3::Find::Util; + +use strict; +use warnings; + +use base qw(Exporter); +use vars qw(@EXPORT_OK); + +@EXPORT_OK = qw(build_query); + +sub build_query { + my @args = @_; + + # first find all the directories + my @dirs; + while (local $_ = shift @args) { + if (/^-/) { + # whoops, there's the beginning of the query + unshift @args, $_; + last; + } else { + push @dirs, $_; + } + } + + # now build the query hash + my %query; + my $field; + while (local $_ = shift @args) { + if (/^--?(.*)/) { + $field = uc $1; + } else { + $field ? push @{ $query{$field} }, $_ : die "Need a field name before value '$_'\n"; + } + } + + return (\@dirs, \%query); +} + +# module return +1; Index: /tags/0.05/mkreadme =================================================================== --- /tags/0.05/mkreadme (revision 26) +++ /tags/0.05/mkreadme (revision 26) @@ -0,0 +1,17 @@ +#!/bin/sh +perl -I./lib -M$1 -e"\$ver = '$1 version ' . $1->VERSION; print qq[\$ver\\n] . '=' x length(\$ver) . qq[\\n\\n]" + +PM_FILE=./lib/`echo $1 | sed 's/::/\//g'`.pm + +podselect -section 'DESCRIPTION/!.' $PM_FILE | pod2text + +echo 'INSTALL' +echo ' To install this module type the following:' +echo +echo ' perl Makefile.PL' +echo ' make' +echo ' make test' +echo ' make install' +echo + +podselect -section 'SYNOPSIS|REQUIRES|COPYRIGHT AND LICENSE' $PM_FILE | pod2text Index: /tags/0.05/t/01.t =================================================================== --- /tags/0.05/t/01.t (revision 26) +++ /tags/0.05/t/01.t (revision 26) @@ -0,0 +1,18 @@ +#!/usr/bin/perl -w +use strict; + +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl MP3-Find.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test::More tests => 1; +BEGIN { use_ok('MP3::Find') }; + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + Index: /tags/0.05/t/02-filesystem.t =================================================================== --- /tags/0.05/t/02-filesystem.t (revision 26) +++ /tags/0.05/t/02-filesystem.t (revision 26) @@ -0,0 +1,31 @@ +#!/usr/bin/perl -w +use strict; + +use Test::More tests => 6; +BEGIN { use_ok('MP3::Find::Filesystem') }; + +my $SEARCH_DIR = 't/mp3s'; +my $EXCLUDE_DIR = 't/mp3s/dont_look_here'; +my $MP3_COUNT = 1; +my $EXCLUDED_MP3_COUNT = 1; + +# exercise the object + +my $finder = MP3::Find::Filesystem->new; +isa_ok($finder, 'MP3::Find::Filesystem'); + +# a most basic search: +my @res = $finder->find_mp3s(dir => $SEARCH_DIR); +is(scalar(@res), $MP3_COUNT, 'dir as scalar'); + +@res = $finder->find_mp3s(dir => [$SEARCH_DIR]); +is(scalar(@res), $MP3_COUNT, 'dir as ARRAY ref'); + +# exclude +@res = $finder->find_mp3s(dir => $SEARCH_DIR, exclude_path => $EXCLUDE_DIR); +is(scalar(@res), $MP3_COUNT - $EXCLUDED_MP3_COUNT, 'excluded directory'); + +@res = $finder->find_mp3s(dir => $SEARCH_DIR, exclude_path => [$EXCLUDE_DIR]); +is(scalar(@res), $MP3_COUNT - $EXCLUDED_MP3_COUNT, 'excluded directory as array'); + +#TODO: get some test mp3s Index: /tags/0.05/t/03-db.t =================================================================== --- /tags/0.05/t/03-db.t (revision 26) +++ /tags/0.05/t/03-db.t (revision 26) @@ -0,0 +1,51 @@ +#!/usr/bin/perl -w +use strict; + +use Test::More; + +BEGIN { + eval { require DBI }; + plan skip_all => 'DBI required to use MP3::Find::DB backend' if $@; + eval { require DBD::SQLite }; + plan skip_all => 'DBD::SQLite required to use MP3::Find::DB backend' if $@; + eval { require SQL::Abstract }; + plan skip_all => 'SQL::Abstract required to use MP3::Find::DB backend' if $@; + + use_ok('MP3::Find::DB') +}; + +plan tests => 7; + +my $SEARCH_DIR = 't/mp3s'; +my $DB_FILE = 't/mp3.db'; +my $MP3_COUNT = 1; + +# exercise the object + +my $finder = MP3::Find::DB->new( + status_callback => sub {}, # be quiet about updates +); +isa_ok($finder, 'MP3::Find::DB'); + +eval { $finder->create_db() }; +ok($@, 'create_db dies when not given a database name'); +eval { $finder->update_db() }; +ok($@, 'update_db dies when not given a database name'); +eval { $finder->destroy_db() }; +ok($@, 'destroy_db dies when not given a database name'); + + +# create a test db +unlink $DB_FILE; +$finder->create_db($DB_FILE); +ok(-e $DB_FILE, 'db file is there'); + +my $count = $finder->update_db($DB_FILE, $SEARCH_DIR); +is($count, $MP3_COUNT, 'added all the mp3s to the db'); + +# remove the db +$finder->destroy_db($DB_FILE); +ok(!-e $DB_FILE, 'db file is gone'); + +#TODO: get some test mp3s +#TODO: write a set of common set of test querys and counts for all the backends Index: /tags/0.05/t/mp3s/not-an-mp3 =================================================================== --- /tags/0.05/t/mp3s/not-an-mp3 (revision 26) +++ /tags/0.05/t/mp3s/not-an-mp3 (revision 26) @@ -0,0 +1,1 @@ +# included to make sure MP3::Find is only looking at *.mp3 files