[1] | 1 | package MP3::Find::DB; |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | |
---|
| 6 | use base qw(MP3::Find::Base); |
---|
[10] | 7 | use Carp; |
---|
[1] | 8 | |
---|
| 9 | use DBI; |
---|
| 10 | use SQL::Abstract; |
---|
| 11 | |
---|
| 12 | my $sql = SQL::Abstract->new; |
---|
| 13 | |
---|
[10] | 14 | my @COLUMNS = ( |
---|
| 15 | [ mtime => 'INTEGER' ], # the filesystem mtime, so we can do incremental updates |
---|
| 16 | [ FILENAME => 'TEXT' ], |
---|
| 17 | [ TITLE => 'TEXT' ], |
---|
| 18 | [ ARTIST => 'TEXT' ], |
---|
| 19 | [ ALBUM => 'TEXT' ], |
---|
| 20 | [ YEAR => 'INTEGER' ], |
---|
| 21 | [ COMMENT => 'TEXT' ], |
---|
| 22 | [ GENRE => 'TEXT' ], |
---|
| 23 | [ TRACKNUM => 'INTEGER' ], |
---|
| 24 | [ VERSION => 'NUMERIC' ], |
---|
| 25 | [ LAYER => 'INTEGER' ], |
---|
| 26 | [ STEREO => 'TEXT' ], |
---|
| 27 | [ VBR => 'TEXT' ], |
---|
| 28 | [ BITRATE => 'INTEGER' ], |
---|
| 29 | [ FREQUENCY => 'INTEGER' ], |
---|
| 30 | [ SIZE => 'INTEGER' ], |
---|
| 31 | [ OFFSET => 'INTEGER' ], |
---|
| 32 | [ SECS => 'INTEGER' ], |
---|
| 33 | [ MM => 'INTEGER' ], |
---|
| 34 | [ SS => 'INTEGER' ], |
---|
| 35 | [ MS => 'INTEGER' ], |
---|
| 36 | [ TIME => 'TEXT' ], |
---|
| 37 | [ COPYRIGHT => 'TEXT' ], |
---|
| 38 | [ PADDING => 'INTEGER' ], |
---|
| 39 | [ MODE => 'INTEGER' ], |
---|
| 40 | [ FRAMES => 'INTEGER' ], |
---|
| 41 | [ FRAME_LENGTH => 'INTEGER' ], |
---|
| 42 | [ VBR_SCALE => 'INTEGER' ], |
---|
| 43 | ); |
---|
| 44 | |
---|
| 45 | |
---|
[1] | 46 | sub search { |
---|
| 47 | my $self = shift; |
---|
| 48 | my ($query, $dirs, $sort, $options) = @_; |
---|
| 49 | |
---|
[10] | 50 | croak 'Need a database name to search (set "db_file" in the call to find_mp3s)' unless $$options{db_file}; |
---|
[1] | 51 | |
---|
[10] | 52 | my $dbh = DBI->connect("dbi:SQLite:dbname=$$options{db_file}", '', '', {RaiseError => 1}); |
---|
| 53 | |
---|
[1] | 54 | # use the 'LIKE' operator to ignore case |
---|
| 55 | my $op = $$options{ignore_case} ? 'LIKE' : '='; |
---|
| 56 | |
---|
| 57 | # add the SQL '%' wildcard to match substrings |
---|
| 58 | unless ($$options{exact_match}) { |
---|
| 59 | for my $value (values %$query) { |
---|
| 60 | $value = [ map { "%$_%" } @$value ]; |
---|
| 61 | } |
---|
| 62 | } |
---|
| 63 | |
---|
| 64 | my ($where, @bind) = $sql->where( |
---|
| 65 | { map { $_ => { $op => $query->{$_} } } keys %$query }, |
---|
| 66 | ( @$sort ? [ map { uc } @$sort ] : () ), |
---|
| 67 | ); |
---|
| 68 | |
---|
| 69 | my $select = "SELECT * FROM mp3 $where"; |
---|
| 70 | |
---|
| 71 | my $sth = $dbh->prepare($select); |
---|
| 72 | $sth->execute(@bind); |
---|
| 73 | |
---|
| 74 | my @results; |
---|
| 75 | while (my $row = $sth->fetchrow_hashref) { |
---|
| 76 | push @results, $row; |
---|
| 77 | } |
---|
| 78 | |
---|
| 79 | return @results; |
---|
| 80 | } |
---|
| 81 | |
---|
[10] | 82 | sub create_db { |
---|
| 83 | my $self = shift; |
---|
| 84 | my $db_file = shift or croak "Need a name for the database I'm about to create"; |
---|
| 85 | my $dbh = DBI->connect("dbi:SQLite:dbname=$db_file", '', '', {RaiseError => 1}); |
---|
| 86 | $dbh->do('CREATE TABLE mp3 (' . join(',', map { "$$_[0] $$_[1]" } @COLUMNS) . ')'); |
---|
| 87 | } |
---|
| 88 | |
---|
| 89 | sub update_db { |
---|
| 90 | my $self = shift; |
---|
| 91 | my $db_file = shift or croak "Need the name of the databse to update"; |
---|
| 92 | my $dirs = shift; |
---|
| 93 | |
---|
| 94 | my @dirs = ref $dirs eq 'ARRAY' ? @$dirs : ($dirs); |
---|
| 95 | |
---|
| 96 | my $dbh = DBI->connect("dbi:SQLite:dbname=$db_file", '', '', {RaiseError => 1}); |
---|
| 97 | my $mtime_sth = $dbh->prepare('SELECT mtime FROM mp3 WHERE FILENAME = ?'); |
---|
| 98 | my $insert_sth = $dbh->prepare( |
---|
| 99 | 'INSERT INTO mp3 (' . |
---|
| 100 | join(',', map { $$_[0] } @COLUMNS) . |
---|
| 101 | ') VALUES (' . |
---|
| 102 | join(',', map { '?' } @COLUMNS) . |
---|
| 103 | ')' |
---|
| 104 | ); |
---|
| 105 | my $update_sth = $dbh->prepare( |
---|
| 106 | 'UPDATE mp3 SET ' . |
---|
| 107 | join(',', map { "$$_[0] = ?" } @COLUMNS) . |
---|
| 108 | ' WHERE FILENAME = ?' |
---|
| 109 | ); |
---|
| 110 | |
---|
| 111 | # the number of records added or updated |
---|
| 112 | my $count = 0; |
---|
| 113 | |
---|
| 114 | # look for mp3s using the filesystem backend |
---|
| 115 | require MP3::Find::Filesystem; |
---|
| 116 | my $finder = MP3::Find::Filesystem->new; |
---|
| 117 | for my $mp3 ($finder->find_mp3s(dir => \@dirs, no_format => 1)) { |
---|
| 118 | # see if the file has been modified since it was first put into the db |
---|
| 119 | $mp3->{mtime} = (stat($mp3->{FILENAME}))[9]; |
---|
| 120 | $mtime_sth->execute($mp3->{FILENAME}); |
---|
| 121 | my $records = $mtime_sth->fetchall_arrayref; |
---|
| 122 | |
---|
| 123 | warn "Multiple records for $$mp3{FILENAME}\n" if @$records > 1; |
---|
| 124 | |
---|
[12] | 125 | #TODO: maybe print status updates somewhere else? |
---|
[10] | 126 | if (@$records == 0) { |
---|
| 127 | $insert_sth->execute(map { $mp3->{$$_[0]} } @COLUMNS); |
---|
| 128 | print STDERR "A $$mp3{FILENAME}\n"; |
---|
| 129 | $count++; |
---|
| 130 | } elsif ($mp3->{mtime} > $$records[0][0]) { |
---|
| 131 | # the mp3 file is newer than its record |
---|
| 132 | $update_sth->execute((map { $mp3->{$$_[0]} } @COLUMNS), $mp3->{FILENAME}); |
---|
| 133 | print STDERR "U $$mp3{FILENAME}\n"; |
---|
| 134 | $count++; |
---|
| 135 | } |
---|
| 136 | } |
---|
| 137 | |
---|
| 138 | # as a workaround for the 'closing dbh with active staement handles warning |
---|
| 139 | # (see http://rt.cpan.org/Ticket/Display.html?id=9643#txn-120724) |
---|
| 140 | foreach ($mtime_sth, $insert_sth, $update_sth) { |
---|
[12] | 141 | $_->{RaiseError} = 0; # don't die on error |
---|
[10] | 142 | $_->{Active} = 1; |
---|
| 143 | $_->finish; |
---|
| 144 | } |
---|
| 145 | |
---|
| 146 | return $count; |
---|
| 147 | } |
---|
| 148 | |
---|
| 149 | sub destroy_db { |
---|
| 150 | my $self = shift; |
---|
| 151 | my $db_file = shift or croak "Need the name of a database to destory"; |
---|
| 152 | unlink $db_file; |
---|
| 153 | } |
---|
| 154 | |
---|
[1] | 155 | # module return |
---|
| 156 | 1; |
---|
[3] | 157 | |
---|
| 158 | =head1 NAME |
---|
| 159 | |
---|
| 160 | MP3::Find::DB - SQLite database backend to MP3::Find |
---|
| 161 | |
---|
| 162 | =head1 SYNOPSIS |
---|
| 163 | |
---|
| 164 | use MP3::Find::DB; |
---|
| 165 | my $finder = MP3::Find::DB->new; |
---|
| 166 | |
---|
| 167 | my @mp3s = $finder->find_mp3s( |
---|
| 168 | dir => '/home/peter/music', |
---|
| 169 | query => { |
---|
| 170 | artist => 'ilyaimy', |
---|
| 171 | album => 'myxomatosis', |
---|
| 172 | }, |
---|
| 173 | ignore_case => 1, |
---|
[10] | 174 | db_file => 'mp3.db', |
---|
[3] | 175 | ); |
---|
[10] | 176 | |
---|
| 177 | # you can do things besides just searching the database |
---|
| 178 | |
---|
| 179 | # create another database |
---|
| 180 | $finder->create_db('my_mp3s.db'); |
---|
| 181 | |
---|
| 182 | # update the database from the filesystem |
---|
| 183 | $finder->update_db('my_mp3s.db', ['/home/peter/mp3', '/home/peter/cds']); |
---|
| 184 | |
---|
| 185 | # and then blow it away |
---|
| 186 | $finder->destroy_db('my_mp3s.db'); |
---|
[3] | 187 | |
---|
| 188 | =head1 REQUIRES |
---|
| 189 | |
---|
| 190 | L<DBI>, L<DBD::SQLite>, L<SQL::Abstract> |
---|
| 191 | |
---|
| 192 | =head1 DESCRIPTION |
---|
| 193 | |
---|
| 194 | This is the SQLite database backend for L<MP3::Find>. |
---|
| 195 | |
---|
| 196 | B<Note:> I'm still working out some kinks in here, so this backend |
---|
| 197 | is currently not as stable as the Filesystem backend. |
---|
| 198 | |
---|
| 199 | =head2 Special Options |
---|
| 200 | |
---|
| 201 | =over |
---|
| 202 | |
---|
| 203 | =item C<db_file> |
---|
| 204 | |
---|
| 205 | The name of the SQLite database file to use. Defaults to F<~/mp3.db>. |
---|
| 206 | |
---|
| 207 | The database should have at least one table named C<mp3> with the |
---|
| 208 | following schema: |
---|
| 209 | |
---|
| 210 | CREATE TABLE mp3 ( |
---|
| 211 | mtime INTEGER, |
---|
| 212 | FILENAME TEXT, |
---|
| 213 | TITLE TEXT, |
---|
| 214 | ARTIST TEXT, |
---|
| 215 | ALBUM TEXT, |
---|
| 216 | YEAR INTEGER, |
---|
| 217 | COMMENT TEXT, |
---|
| 218 | GENRE TEXT, |
---|
| 219 | TRACKNUM INTEGER, |
---|
| 220 | VERSION NUMERIC, |
---|
| 221 | LAYER INTEGER, |
---|
| 222 | STEREO TEXT, |
---|
| 223 | VBR TEXT, |
---|
| 224 | BITRATE INTEGER, |
---|
| 225 | FREQUENCY INTEGER, |
---|
| 226 | SIZE INTEGER, |
---|
| 227 | OFFSET INTEGER, |
---|
| 228 | SECS INTEGER, |
---|
| 229 | MM INTEGER, |
---|
| 230 | SS INTEGER, |
---|
| 231 | MS INTEGER, |
---|
| 232 | TIME TEXT, |
---|
| 233 | COPYRIGHT TEXT, |
---|
| 234 | PADDING INTEGER, |
---|
| 235 | MODE INTEGER, |
---|
| 236 | FRAMES INTEGER, |
---|
| 237 | FRAME_LENGTH INTEGER, |
---|
| 238 | VBR_SCALE INTEGER |
---|
| 239 | ); |
---|
| 240 | |
---|
| 241 | =back |
---|
| 242 | |
---|
[10] | 243 | =head1 METHODS |
---|
| 244 | |
---|
| 245 | =head2 create_db |
---|
| 246 | |
---|
| 247 | $finder->create_db($db_filename); |
---|
| 248 | |
---|
| 249 | Creates a SQLite database in the file named c<$db_filename>. |
---|
| 250 | |
---|
| 251 | =head2 update_db |
---|
| 252 | |
---|
| 253 | my $count = $finder->update_db($db_filename, \@dirs); |
---|
| 254 | |
---|
| 255 | Searches for all mp3 files in the directories named by C<@dirs> |
---|
| 256 | using L<MP3::Find::Filesystem>, and adds or updates the ID3 info |
---|
| 257 | from those files to the database. If a file already has a record |
---|
| 258 | in the database, then it will only be updated if it has been modified |
---|
| 259 | sinc ethe last time C<update_db> was run. |
---|
| 260 | |
---|
| 261 | =head2 destroy_db |
---|
| 262 | |
---|
| 263 | $finder->destroy_db($db_filename); |
---|
| 264 | |
---|
| 265 | Permanantly removes the database. |
---|
| 266 | |
---|
[3] | 267 | =head1 TODO |
---|
| 268 | |
---|
| 269 | Database maintanence routines (e.g. clear out old entries) |
---|
| 270 | |
---|
[10] | 271 | Allow the passing of a DSN or an already created C<$dbh> instead |
---|
| 272 | of a SQLite database filename. |
---|
| 273 | |
---|
[3] | 274 | =head1 SEE ALSO |
---|
| 275 | |
---|
[10] | 276 | L<MP3::Find>, L<MP3::Find::Filesystem>, L<mp3db> |
---|
[3] | 277 | |
---|
| 278 | =head1 AUTHOR |
---|
| 279 | |
---|
| 280 | Peter Eichman <peichman@cpan.org> |
---|
| 281 | |
---|
| 282 | =head1 COPYRIGHT AND LICENSE |
---|
| 283 | |
---|
| 284 | Copyright (c) 2006 by Peter Eichman. All rights reserved. |
---|
| 285 | |
---|
| 286 | This program is free software; you can redistribute it and/or |
---|
| 287 | modify it under the same terms as Perl itself. |
---|
| 288 | |
---|
| 289 | =cut |
---|