soepkiptng_write_info

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