soepkiptng_write_info

   1 #!/usr/bin/perl
   2 ############################################################################
   3 # soepkiptng (c) copyright 2000 Eric Lammerts <eric@lammerts.org>.
   4 # $Id$
   5 ############################################################################
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License, version 2, as
   8 # published by the Free Software Foundation.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # A copy of the GNU General Public License is available on the World Wide Web
  16 # at `http://www.gnu.org/copyleft/gpl.html'.  You can also obtain it by
  17 # writing to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  18 # Boston, MA 02111-1307, USA.
  19 ############################################################################
  20
  21 my $progdir;
  22 BEGIN {
  23         use Cwd 'abs_path';
  24
  25         # find program directory
  26         $_ = $0;
  27         while(-l) {
  28                 my $l = readlink or die "readlink $_: $!\n";
  29                 if($l =~ m|^/|) { $_ = $l; } else { s|[^/]*$|/$l|; }
  30         }
  31         m|(.*)/|;
  32         $progdir = abs_path($1);
  33
  34         unshift @INC, "$progdir/lib";
  35 }
  36 require "$progdir/soepkiptng.lib";
  37 $ENV{PATH} = "$progdir/bin:$ENV{PATH}";
  38
  39 use integer;
  40 use DBI;
  41 use Getopt::Std;
  42 use MP3::Tag;
  43 #use Data::Dumper;
  44
  45 use vars qw/$opt_r $opt_h $opt_q $opt_t $opt_l $opt_c/;
  46
  47 %latin1_to_ascii = (
  48         192 => "A", 193 => "A", 194 => "A", 195 => "A", 196 => "A", 197 => "A",
  49         198 => "AE", 199 => "C", 200 => "E", 201 => "E", 202 => "E", 203 => "E",
  50         204 => "I", 205 => "I", 206 => "I", 207 => "I", 209 => "N", 210 => "O",
  51         211 => "O", 212 => "O", 213 => "O", 214 => "O", 215 => "x", 216 => "O",
  52         217 => "U", 218 => "U", 219 => "U", 220 => "U", 221 => "Y", 223 => "ss",
  53         224 => "a", 225 => "a", 226 => "a", 227 => "a", 228 => "a", 229 => "a",
  54         230 => "ae", 231 => "c", 232 => "e", 233 => "e", 234 => "e", 235 => "e",
  55         236 => "i", 237 => "i", 238 => "i", 239 => "i", 241 => "n", 242 => "o",
  56         243 => "o", 244 => "o", 245 => "o", 246 => "o", 248 => "o", 249 => "u",
  57         250 => "u", 251 => "u", 252 => "u", 253 => "y", 255 => "y",
  58 );
  59
  60 sub simplify($) {
  61         my ($a) = @_;
  62
  63         $a =~ s/-/_/g;
  64         $a =~ s/[\[(](.*)/-\1/;
  65         $a =~ s/[ _]?&[_ ]?/_and_/;
  66         $a =~ s/([\xc0-\xff])/lc($latin1_to_ascii{ord($1)}) || $1/ge;
  67         $a =~ s/[^-A-Za-z0-9]+/_/g;
  68         $a =~ s/_?-_?/-/g;
  69         $a =~ s/_$//;
  70         return lc($a);
  71 };
  72
  73 sub do_dir($$) {
  74         my ($dbh, $f) = @_;
  75
  76         $opt_r or return;
  77         $f = abs_path($f);
  78         $f =~ s|/+$||;
  79         my $q = "SELECT filename,artist.name as artist,album.name as album" .
  80                 " FROM song,artist,album" .
  81                 " WHERE song.artist_id=artist.id AND song.album_id=album.id" .
  82                 " AND present AND filename LIKE ?";
  83         my $sth = $dbh->prepare($q);
  84         $sth->execute("$f/%")
  85                 or die "can't do sql command: " . $dbh->errstr;
  86
  87         my $album;
  88         my $artist;
  89         my @files;
  90         while($_ = $sth->fetchrow_hashref) {
  91                 (my $dir = $_->{filename}) =~ s|^(.*)/[^/]+$|\1|;
  92                 next unless $dir eq $f;         # skip files in subdirs
  93                 if($artist && $artist ne $_->{artist}) {
  94                         warn "$f: No common artist name found.\n";
  95                         return;
  96                 }
  97                 $artist = $_->{artist};
  98                 if($album && $album ne $_->{album}) {
  99                         warn "$f: No common album name found.\n";
 100                         return;
 101                 }
 102                 $album = $_->{album};
 103                 push @files, $_->{filename};
 104         }
 105         $sth->finish;
 106         my $newname = "";
 107         $newname .= simplify($artist) . "-" if $artist;
 108         $newname .= simplify($album);
 109         $f =~ m|^(.*)/|;
 110         $newname = "$1/$newname";
 111
 112         if($f eq $newname) {
 113         } elsif(-e $newname) {
 114                 warn "$f: $newname exists, skipping\n";
 115         } else {
 116                 warn "renaming $f -> $newname\n";
 117                 if(rename $f, $newname) {
 118                         foreach(@files) {
 119                                 (my $fnew = $_) =~ s|.*/|$newname/|;
 120
 121                                 $dbh->do("DELETE FROM song WHERE filename=?",
 122                                         undef, $fnew)
 123                                         or die "can't do sql command: " . $dbh->errstr;
 124                                 $dbh->do("UPDATE song SET filename=? WHERE filename=?",
 125                                         undef, $fnew, $_)
 126                                         or die "can't do sql command: " . $dbh->errstr;
 127                         }
 128                 } else {
 129                         warn "rename $f -> $newname: $!\n";
 130                 }
 131         }
 132 }
 133
 134 sub do_file($$) {
 135         my ($dbh, $f) = @_;
 136
 137         $f =~ s|^\./+||;
 138         my $fullf = $f;
 139         $fullf =~ m|/| or $fullf = "./$f";
 140         $fullf =~ s|(.*)/|abs_path($1) . "/"|e;
 141
 142         $q = "SELECT song.id,title,artist.name,album.name,track,length" .
 143              " FROM song,artist,album" .
 144              " WHERE song.artist_id=artist.id AND song.album_id=album.id" .
 145              " AND present AND filename=?";
 146         $sth = $dbh->prepare($q);
 147         $sth->execute($fullf)
 148                 or die "can't do sql command: " . $dbh->errstr;
 149
 150         ($id, $ti, $ar, $al, $tr, $len) = $sth->fetchrow_array or do {
 151                 my $shortf = $fullf;
 152                 $shortf =~ s|^/+||;
 153                 $q = "SELECT song.id,title,artist.name,album.name,track,length" .
 154                      " FROM song,artist,album" .
 155                      " WHERE song.artist_id=artist.id AND song.album_id=album.id" .
 156                      " AND present AND filename LIKE ?";
 157                 $sth = $dbh->prepare($q);
 158                 for(;;) {
 159 #                       warn "===== %/$shortf\n";
 160                         $sth->execute("%/$shortf")
 161                                 or die "can't do sql command: " . $dbh->errstr;
 162
 163                         ($id, $ti, $ar, $al, $tr, $len) = $sth->fetchrow_array
 164                                 and last;
 165
 166                         $shortf =~ s|[^/]+/+|| or do {
 167                                 warn "$f: not found in dbase\n" unless $opt_q;
 168                                 return 1;
 169                         }
 170                 }
 171                 warn "$f: partial filename match on $shortf\n" unless $opt_q;
 172         };
 173         $sth->finish;
 174
 175         next unless -s $f;
 176
 177         if($f =~ /\.mp[123]$/i) {
 178                 do_mp3($dbh, $f, $ar, $ti, $al, $tr, $len);
 179         } elsif($f =~ /\.flac$/i) {
 180                 do_flac($dbh, $f, $ar, $ti, $al, $tr, $len);
 181         } elsif($f =~ /\.ogg$/i) {
 182                 do_ogg($dbh, $f, $ar, $ti, $al, $tr, $len);
 183         } else {
 184                 warn "unknown file type: $f\n";
 185         }
 186
 187         if($opt_r) {
 188                 my $ext = "";
 189                 $f =~ /.*\.(.*?)$/ and $ext = lc($1);
 190                 my $newname = "";
 191                 $newname .= sprintf "%02d-", $tr if $tr;
 192                 $newname .= simplify($ar) . "-" if $ar;
 193                 $newname .= simplify($ti);
 194                 if($opt_l && length("$newname.$ext") > $opt_l) {
 195                         $newname = substr($newname, 0, $opt_l - length(".$ext") - 1);
 196                         $newname =~ s/_?$/_/;
 197                 }
 198                 $newname .= ".$ext";
 199                 $fullf =~ m|^(.*)/|;
 200                 $newname = "$1/$newname";
 201
 202                 if($newname ne $fullf) {
 203                         warn "renaming $fullf -> $newname\n";
 204                         if(-e $newname) {
 205                                 warn "$f: $newname exists, skipping\n";
 206                         } elsif(!$opt_t) {
 207                                 if(rename $fullf, $newname) {
 208                                         $dbh->do("DELETE FROM song WHERE filename=?",
 209                                                 undef, $newname)
 210                                                 or die "can't do sql command: " . $dbh->errstr;
 211                                         $dbh->do("UPDATE song SET filename=? WHERE id=?",
 212                                                 undef, $newname, $id)
 213                                                 or die "can't do sql command: " . $dbh->errstr;
 214                                 } else {
 215                                         warn "rename $fullf -> $newname: $!\n";
 216                                 }
 217                         }
 218                 }
 219         }
 220         return 1;
 221 }
 222
 223 sub do_mp3($$$$$$$) {
 224         my ($dbh, $f, $ar, $ti, $al, $tr, $len) = @_;
 225
 226         open F, "+<$f" or do {
 227                 warn "$f: $!\n";
 228                 return 1;
 229         };
 230         for(;;) {
 231                 seek F, -128, 2;
 232                 read F, $buf, 128;
 233                 $buf =~ /^TAG/ or last;
 234                 warn "$f: removed ID3 tag\n";
 235                 seek F, -128, 2;
 236                 truncate F, tell F or warn "truncate $f: $!\n"
 237                         unless $opt_t;
 238                 last if $opt_t;
 239         }
 240         close F;
 241
 242         $mp3 = MP3::Tag->new($f) or die "$f: $!\n";
 243         $mp3->config("autoinfo", "ID3v2");
 244         my ($p_ti, $p_tr, $p_ar, $p_al) = $mp3->autoinfo();
 245
 246         my $p_len = 0;
 247         my $newtag = $mp3->{ID3v2};
 248         if(defined($newtag)) {
 249                 $p_len = $mp3->{ID3v2}->getFrame("TLEN");
 250                 $newtag->remove_frame('TIT2');
 251                 $newtag->remove_frame('TPE1');
 252                 $newtag->remove_frame('TALB');
 253                 $newtag->remove_frame('TRCK');
 254                 $newtag->remove_frame('TLEN');
 255         } else {
 256                 $newtag = $mp3->newTag('ID3v2');
 257         }
 258
 259         if($p_ti ne $ti || $p_tr != $tr || $p_ar ne $ar || $p_al ne $al || $p_len != 1000 * $len) {
 260                 $newtag->add_frame('TIT2', $ti) if $ti;
 261                 $newtag->add_frame('TPE1', $ar) if $ar;
 262                 $newtag->add_frame('TALB', $al) if $al;
 263                 $newtag->add_frame('TRCK', $tr) if $tr;
 264                 $newtag->add_frame('TLEN', 1000 * $len) if $len;
 265                 warn "$f: updating ID3v2 tag\n";
 266                 $newtag->write_tag()
 267                         unless $opt_t;
 268         }
 269         return 1;
 270 }
 271
 272 sub do_ogg($$$$$$$) {
 273         my ($dbh, $f, $ar, $ti, $al, $tr, $len) = @_;
 274         local *FR;
 275         local *FW;
 276
 277         # read current tags & see what needs to be changed
 278         my $needchange = 0;
 279         if(open(FR, "-|") == 0) {
 280                 exec "vorbiscomment", "-ql", $f;
 281                 die "vorbiscomment";
 282         }
 283         while(<FR>) {
 284                 s/\s+$//;
 285                 if((/^artist=(.*)/ && $1 ne $ar) ||
 286                    (/^title=(.*)/ && $1 ne $ti) ||
 287                    (/^album=(.*)/ && $1 ne $al) ||
 288                    (/^tracknumber=(.*)/ && $1 != $tr)) {
 289                         $needchange = 1;
 290                         last;
 291                 }
 292         }
 293         close FR;
 294
 295         $needchange or return 1;
 296         warn "$f: updating vorbis comments\n";
 297         return 1 if $opt_t;
 298
 299         if(open(FR, "-|") == 0) {
 300                 exec "vorbiscomment", "-ql", $f;
 301                 die "vorbiscomment";
 302         }
 303         if(open(FW, "|-") == 0) {
 304                 exec "vorbiscomment", "-qw", $f;
 305                 die "vorbiscomment";
 306         }
 307         # print new info
 308         print FW <<EOF;
 309 artist=$ar
 310 title=$ti
 311 album=$al
 312 tracknumber=$tr
 313 EOF
 314         # copy other tags verbatim
 315         while(<FR>) {
 316                 next if /^(artist|title|album|tracknumber)=/;
 317                 print FW $_;
 318         }
 319         close FR;
 320         close FW;
 321         return 1;
 322 }
 323
 324 sub do_flac($$$$$$$) {
 325         my ($dbh, $f, $ar, $ti, $al, $tr, $len) = @_;
 326         local *F;
 327
 328         # read current tags & see what needs to be changed
 329         my @changeargs = ();
 330         if(open(F, "-|") == 0) {
 331                 exec "metaflac", "--export-vc-to=-", $f;
 332                 die "metaflac";
 333         }
 334         while(<F>) {
 335                 s/\s+$//;
 336                 if(/^artist=(.*)/ && $1 ne $ar) {
 337                         push @changeargs, "--remove-vc-field=artist", "--set-vc-field=artist=$ar";
 338                 } elsif(/^title=(.*)/ && $1 ne $ti) {
 339                         push @changeargs, "--remove-vc-field=title", "--set-vc-field=title=$ti";
 340                 } elsif(/^album=(.*)/ && $1 ne $al) {
 341                         push @changeargs, "--remove-vc-field=album", "--set-vc-field=album=$al";
 342                 } elsif(/^tracknumber=(.*)/ && $1 != $tr) {
 343                         push @changeargs, "--remove-vc-field=tracknumber", "--set-vc-field=tracknumber=$tr";
 344                 }
 345         }
 346         close F;
 347
 348         # change it
 349         if(@changeargs) {
 350                 warn "$f: updating vorbis comments\n";
 351                 if(!$opt_t) { system "metaflac", @changeargs, $f; }
 352         }
 353         return 1;
 354 }
 355
 356
 357 getopts('rhqtl:c:');
 358
 359 read_configfile(\%conf, $opt_c);
 360
 361 ($prog = $0) =~ s|.*/||;
 362 if($opt_h || !@ARGV) {
 363         print <<EOF;
 364 Usage: $prog [-qrt] mp3files...
 365
 366 Options:
 367        -r : rename files.
 368        -q : don't warn about partial/failed filename matches.
 369        -t : testmode, don't actually write any tags.
 370
 371 $prog reads Artist/Title/Album/Track info from the SoepkipTNG
 372 database and writes it to the specified files using ID3v2 (unless the files
 373 already have ID3v2 tags containing the exact same info). All ID3v1 tags are
 374 removed.
 375
 376 If the -r switch is used, the files are renamed to a standard format:
 377 track-artist-title.mp3 (if there is a track number) or artist-title.mp3
 378 (if there is no track number).
 379 * track consists of two or more digits.
 380 * artist may contain only alphanumeric characters and underscores.
 381 * title may contain only alphanumeric characters, underscores and dashes.
 382
 383 EOF
 384         exit;
 385 }
 386
 387 $| = 1;
 388
 389 my $dbh = DBI->connect("DBI:$conf{'db_type'}:$conf{'db_name'}:$conf{'db_host'}",
 390         $conf{'db_user'}, $conf{'db_pass'})
 391         or die "can't connect to database";
 392
 393 foreach $f (@ARGV) {
 394         if(-d $f) {
 395                 do_dir($dbh, $f);
 396         } elsif(-s _) {
 397                 do_file($dbh, $f);
 398         }
 399 }
 400
 401 $dbh->disconnect();