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, $trimlength);
 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,trimlength 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 ? ORDER BY track, trimstart");
 142
 143         my $partial = 0;
 144         for(;;) {
 145                 $sth->execute($filename_noext)
 146                         or die "can't do sql command: " . $dbh->errstr;
 147                 ($id[0], $ti, $ar, $al, $tr, $len, $lyrics, $language, $description, $uuid, $trimlength) =
 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         if($trimlength) {
 163                 # split song
 164                 my ($id2, $ti2);
 165                 while(($id2, $ti2) = $sth->fetchrow_array) {
 166                         push @id, $id2;
 167                         $ti .= " / $ti2";
 168                 }
 169         }
 170         $sth->finish;
 171         $partial and warn "$f: partial filename match on $filename_noext\n" unless $opt_q;
 172
 173         next unless -s $f;
 174
 175         if($opt_s) {
 176                 do_soepkip($dbh, $f, $ar, $ti, $al, $tr, $len, $lyrics, $description, $language, $uuid);
 177         } elsif(!$opt_f && (stat $f)[3] != 1) {
 178                 warn "$f: file has hardlinks, not writing (use -f to override)\n";
 179         } elsif($f =~ /\.mp[123]$/i) {
 180                 do_mp3($dbh, $f, $ar, $ti, $al, $tr, $len, $lyrics, $description, $language, $uuid);
 181         } elsif($f =~ /\.flac$/i) {
 182                 do_flac($dbh, $f, $ar, $ti, $al, $tr, $len);
 183         } elsif($f =~ /\.ogg$/i) {
 184                 do_ogg($dbh, $f, $ar, $ti, $al, $tr, $len);
 185         } else {
 186                 warn "unknown file type: $f\n";
 187         }
 188
 189         if($opt_r) {
 190                 my $ext = "";
 191                 $f =~ /.*\.(.*?)$/ and $ext = lc($1);
 192                 my $newname = "";
 193                 if($opt_D) {
 194                         $newname .= string_to_filename($ar, $language) . "-" if $ar;
 195                         $newname .= string_to_filename($al);
 196                         mkdir $newname;
 197                         $newname .= "/";
 198                 }
 199                 $newname .= sprintf "%02d-", $tr if $tr;
 200                 $newname .= string_to_filename($ar, $language) . "-" if $ar;
 201                 $newname .= string_to_filename($ti);
 202                 $newname =~ s/--+/-/;
 203                 #$newname = sprintf "%02d - ", $tr if $tr; $newname .= "$ar - $ti"; $newname =~ s/([\x80-\xff])/lc($latin9_to_ascii{ord($1)}) || $1/ge;
 204                 if($opt_l && length("$newname.$ext") > $opt_l) {
 205                         $newname = substr($newname, 0, $opt_l - length(".$ext") - 1);
 206                         $newname =~ s/_?$/_/;
 207                 }
 208                 $newname .= ".$ext";
 209                 $full_filename =~ m|^(.*)/|;
 210                 $newname = "$1/$newname";
 211
 212                 if($newname ne $full_filename) {
 213                         warn "renaming $full_filename -> $newname\n";
 214                         if(-e $newname) {
 215                                 warn "$f: $newname exists, skipping\n";
 216                         } elsif(!$opt_t) {
 217                                 if(rename $full_filename, $newname) {
 218                                         if(!$partial) {
 219                                                 $dbh->do("DELETE FROM song WHERE filename=?",
 220                                                         undef, $newname)
 221                                                         or die "can't do sql command: " . $dbh->errstr;
 222                                                 foreach my $id (@id) {
 223                                                         $dbh->do("UPDATE song SET filename=? WHERE id=?",
 224                                                                 undef, $newname, $id)
 225                                                                 or die "can't do sql command: " . $dbh->errstr;
 226                                                 }
 227                                         }
 228                                 } else {
 229                                         warn "rename $full_filename -> $newname: $!\n";
 230                                 }
 231                         }
 232                 }
 233         }
 234         return 1;
 235 }
 236
 237 sub do_soepkip($$$$$$$$$) {
 238         my ($dbh, $f, $ar, $ti, $al, $tr, $len, $lyrics, $lyrdesc, $lyrlang, $uuid) = @_;
 239         local *IN, *OUT;
 240         my $dir = ".";
 241         $f =~ s|(.*)/+|| and $dir = $1;
 242
 243         open OUT, ">$dir/.soepkiptng_info.tmp"
 244                 or do { warn "$dir/.soepkiptng_info.tmp: $!\n"; return undef; };
 245         print OUT <<EOF;
 246 [$f]
 247 artist=$ar
 248 title=$ti
 249 album=$al
 250 track=$tr
 251
 252 EOF
 253         if(open IN, "$dir/.soepkiptng_info") {
 254                 my $skip = 0;
 255                 while(<IN>) {
 256                         if(/^\[([^\]]+)\]/) { $skip = $1 eq $f; }
 257                         print OUT unless $skip;
 258                 }
 259                 close IN;
 260         }
 261         if(!rename "$dir/.soepkiptng_info.tmp", "$dir/.soepkiptng_info") {
 262                 warn "rename $dir/.soepkiptng_info.tmp -> $dir/.soepkiptng_info: $!\n";
 263                 unlink "$dir/.soepkiptng_info.tmp"
 264                         or warn "$dir/.soepkiptng_info.tmp: $!\n";
 265                 return undef;
 266         }
 267         return 1;
 268 }
 269
 270 sub do_mp3($$$$$$$$$) {
 271         my ($dbh, $f, $ar, $ti, $al, $tr, $len, $lyrics, $lyrdesc, $lyrlang, $uuid) = @_;
 272
 273         if(!$opt_1) {
 274                 local *F;
 275                 open F, "+<$f" or do {
 276                         warn "$f: $!\n";
 277                         return 1;
 278                 };
 279                 for(;;) {
 280                         my $buf;
 281
 282                         seek F, -128, 2;
 283                         read F, $buf, 128;
 284                         $buf =~ /^TAG/ or last;
 285                         warn "$f: removed ID3 tag\n";
 286                         seek F, -128, 2;
 287                         truncate F, tell F or warn "truncate $f: $!\n"
 288                                 unless $opt_t;
 289                         last if $opt_t;
 290                 }
 291                 close F;
 292         }
 293
 294         $mp3 = MP3::Tag->new($f) or die "$f: $!\n";
 295         $mp3->config("autoinfo", "ID3v2");
 296         my ($p_ti, $p_tr, $p_ar, $p_al) = $mp3->autoinfo();
 297         my $p_uslt;
 298         my ($p_ufidname, $p_uuid);
 299         my $p_len = 0;
 300         my $newtag = $mp3->{ID3v2};
 301         if(defined($newtag)) {
 302                 $newtag->remove_frame('TIT2');
 303                 $newtag->remove_frame('TPE1');
 304                 $newtag->remove_frame('TALB');
 305                 $newtag->remove_frame('TRCK');
 306                 $p_len = $mp3->{ID3v2}->getFrame('TLEN');
 307                 $newtag->remove_frame('TLEN');
 308                 $p_uslt = $mp3->{ID3v2}->getFrame('USLT');
 309                 $newtag->remove_frame('USLT');
 310                 ($p_ufid) = $mp3->{ID3v2}->getFrame('UFID');
 311                 if($p_ufid->{Text} eq "UUID") { $p_uuid = $p_ufid->{_Data}; }
 312                 $newtag->remove_frame('UFID');
 313                 #warn Dumper($p_uslt);
 314         } else {
 315                 $newtag = $mp3->newTag('ID3v2');
 316         }
 317         $p_uslt->{Text} =~ s/\s+$//;
 318         $lyrics =~ s/\s+$//;
 319         if($opt_f || $p_ti ne $ti || $p_tr != $tr || $p_ar ne $ar || $p_al ne $al ||
 320                 $p_len != 1000 * $len || $p_uslt->{Description} ne $lyrdesc ||
 321                 ($lyrics && $p_uslt->{Language} ne $lyrlang) ||
 322                 $p_uslt->{Text} ne $lyrics || $p_uuid ne $uuid) {
 323
 324                 $newtag->add_frame('TIT2', $ti) if $ti;
 325                 $newtag->add_frame('TPE1', $ar) if $ar;
 326                 $newtag->add_frame('TALB', $al) if $al;
 327                 $newtag->add_frame('TRCK', $tr) if $tr;
 328                 if($len) {
 329                         $newtag->add_frame('TLEN', 1000 * $len);
 330                 }
 331                 if($lyrics) {
 332                         $newtag->add_frame('USLT', 0, $lyrlang, $lyrdesc, $lyrics);
 333                 }
 334                 if($uuid) {
 335                         $newtag->add_frame('UFID', "UUID", $uuid);
 336                 }
 337                 warn "$f: updating ID3v2 tag\n";
 338                 $newtag->write_tag()
 339                         unless $opt_t;
 340         }
 341         if($opt_1) {
 342                 $ti =~ s/^(.{29}).{2,}/$1_/;
 343                 $ar =~ s/^(.{29}).{2,}/$1_/;
 344                 $al =~ s/^(.{29}).{2,}/$1_/;
 345                 my $id3v1 = $mp3->{ID3v1};
 346                 if(defined($id3v1)) {
 347                         if($id3v1->song eq $ti &&
 348                            $id3v1->artist eq $ar &&
 349                            $id3v1->album eq $al &&
 350                            $id3v1->track == $tr) { $id3v1 = undef; }
 351                 } else {
 352                         $id3v1 = $mp3->newTag('ID3v1');
 353                 }
 354                 if(defined($id3v1)) {
 355                         $id3v1->song($ti);
 356                         $id3v1->artist($ar);
 357                         $id3v1->album($al);
 358                         $id3v1->track($tr);
 359                         warn "$f: updating ID3 tag\n";
 360                         $id3v1->writeTag;
 361                 }
 362         }
 363         return 1;
 364 }
 365
 366 sub do_ogg($$$$$$$) {
 367         my ($dbh, $f, $ar, $ti, $al, $tr, $len) = @_;
 368         local *FR;
 369         local *FW;
 370
 371         # read current tags & see what needs to be changed
 372         if(open(FR, "-|") == 0) {
 373                 exec "vorbiscomment", "-ql", $f;
 374                 die "vorbiscomment";
 375         }
 376         my $oldtag;
 377         while(<FR>) {
 378                 s/\s+$//;
 379                 /^(\w+)=(.*)/ and $oldtag{$1} = $2;
 380         }
 381         close FR;
 382
 383         return 1 if !$opt_f && $oldtag{artist} eq $ar && $oldtag{title} eq $ti && $oldtag{album} eq $al && $oldtag{tracknumber} == $tr;
 384
 385         warn "$f: updating vorbis comments\n";
 386         return 1 if $opt_t;
 387
 388         if(open(FR, "-|") == 0) {
 389                 exec "vorbiscomment", "-ql", $f;
 390                 die "vorbiscomment";
 391         }
 392         if(open(FW, "|-") == 0) {
 393                 exec "vorbiscomment", "-qw", $f;
 394                 die "vorbiscomment";
 395         }
 396         # print new info
 397         print FW <<EOF;
 398 artist=$ar
 399 title=$ti
 400 album=$al
 401 tracknumber=$tr
 402 EOF
 403         # copy other tags verbatim
 404         while(<FR>) {
 405                 next if /^(artist|title|album|tracknumber)=/;
 406                 print FW $_;
 407         }
 408         close FR;
 409         close FW;
 410         return 1;
 411 }
 412
 413 sub do_flac($$$$$$$) {
 414         my ($dbh, $f, $ar, $ti, $al, $tr, $len) = @_;
 415         local *F;
 416
 417         # read current tags & see what needs to be changed
 418         my @changeargs = ();
 419         if(open(F, "-|") == 0) {
 420                 exec "metaflac", "--export-tags-to=-", $f;
 421                 die "metaflac";
 422         }
 423         my %oldtag;
 424         while(<F>) {
 425                 s/\s+$//;
 426                 /^(\w+)=(.*)/ and $oldtag{$1} = $2;
 427         }
 428         close F;
 429         if($opt_f || $oldtag{artist} ne $ar) { push @changeargs, "--remove-tag=artist", "--set-tag=artist=$ar"; }
 430         if($opt_f || $oldtag{title} ne $ti)  { push @changeargs, "--remove-tag=title", "--set-tag=title=$ti"; }
 431         if($opt_f || $oldtag{album} ne $al)  { push @changeargs, "--remove-tag=album", "--set-tag=album=$al"; }
 432         if($opt_f || $oldtag{tracknumber} != $tr) { push @changeargs, "--remove-tag=tracknumber", "--set-tag=tracknumber=$tr"; }
 433
 434         # change it
 435         if(@changeargs) {
 436                 warn "$f: updating vorbis comments\n";
 437                 if(!$opt_t) { system "metaflac", @changeargs, $f; }
 438         }
 439         return 1;
 440 }
 441
 442
 443 getopts('rfhqtl:c:1sADS');
 444
 445 read_configfile(\%conf, $opt_c);
 446
 447 ($prog = $0) =~ s|.*/||;
 448 if($opt_h || !@ARGV) {
 449         print <<EOF;
 450 Usage: $prog [-hrqfts] [-l len] mp3files...
 451
 452 Options:
 453        -r      : rename files.
 454        -q      : don't warn about partial/failed filename matches.
 455        -f      : force tag writing
 456        -t      : testmode, don't actually write any tags.
 457        -l len  : restrict length of filenames to 'len'
 458        -1      : also write ID3 tag
 459        -s      : write to .soepkiptng_info instead of file
 460
 461 $prog reads Artist/Title/Album/Track info from the SoepkipTNG
 462 database and writes it to the specified files using ID3v2 (unless the files
 463 already have ID3v2 tags containing the exact same info). All ID3v1 tags are
 464 removed.
 465
 466 If the -r switch is used, the files are renamed to a standard format:
 467 track-artist-title.mp3 (if there is a track number) or artist-title.mp3
 468 (if there is no track number).
 469 * track consists of two or more digits.
 470 * artist may contain only alphanumeric characters and underscores.
 471 * title may contain only alphanumeric characters, underscores and dashes.
 472
 473 EOF
 474         exit;
 475 }
 476
 477 $| = 1;
 478
 479 my $dbh = connect_to_db(\%conf);
 480
 481 foreach $f (@ARGV) {
 482         if(-d $f) {
 483                 do_dir($dbh, $f);
 484         } elsif(-s _) {
 485                 do_file($dbh, $f);
 486         }
 487 }
 488
 489 $dbh->disconnect();