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 $opt_f $opt_1/;
  46
  47 sub do_dir($$) {
  48         my ($dbh, $f) = @_;
  49
  50         $opt_r or return;
  51         $f = abs_path($f);
  52         $f =~ s|/+$||;
  53         my $q = "SELECT filename,artist.name as artist,album.name as album" .
  54                 " FROM song,artist,album" .
  55                 " WHERE song.artist_id=artist.id AND song.album_id=album.id" .
  56                 " AND present AND filename LIKE ?";
  57         my $sth = $dbh->prepare($q);
  58         $sth->execute("$f/%")
  59                 or die "can't do sql command: " . $dbh->errstr;
  60
  61         my $album;
  62         my $artist;
  63         my @files;
  64         while($_ = $sth->fetchrow_hashref) {
  65                 (my $dir = $_->{filename}) =~ s|^(.*)/[^/]+$|\1|;
  66                 next unless $dir eq $f;         # skip files in subdirs
  67                 if($artist && $artist ne $_->{artist}) {
  68                         warn "$f: No common artist name found.\n";
  69                         return;
  70                 }
  71                 $artist = $_->{artist};
  72                 if($album && $album ne $_->{album}) {
  73                         warn "$f: No common album name found.\n";
  74                         return;
  75                 }
  76                 $album = $_->{album};
  77                 push @files, $_->{filename};
  78         }
  79         $sth->finish;
  80         my $newname = "";
  81         $newname .= string_to_filename($artist) . "-" if $artist;
  82         $newname .= string_to_filename($album);
  83         $newname =~ s/--+/-/;
  84         $f =~ m|^(.*)/|;
  85         $newname = "$1/$newname";
  86
  87         if($f eq $newname) {
  88         } elsif(-e $newname) {
  89                 warn "$f: $newname exists, skipping\n";
  90         } else {
  91                 warn "renaming $f -> $newname\n";
  92                 if(rename $f, $newname) {
  93                         foreach(@files) {
  94                                 (my $fnew = $_) =~ s|.*/|$newname/|;
  95
  96                                 $dbh->do("DELETE FROM song WHERE filename=?",
  97                                         undef, $fnew)
  98                                         or die "can't do sql command: " . $dbh->errstr;
  99                                 $dbh->do("UPDATE song SET filename=? WHERE filename=?",
 100                                         undef, $fnew, $_)
 101                                         or die "can't do sql command: " . $dbh->errstr;
 102                         }
 103                 } else {
 104                         warn "rename $f -> $newname: $!\n";
 105                 }
 106         }
 107 }
 108
 109 sub do_file($$) {
 110         my ($dbh, $f) = @_;
 111         my ($id, $ti, $ar, $al, $tr, $len, $lyrics, $description, $language, $uuid);
 112
 113         $f =~ s|^\./+||;
 114
 115         my $full_filename = $f;
 116         $full_filename =~ m|/| or $full_filename = "./$f";      # prepend ./ if relative path
 117         $full_filename =~ s|(.*)/|abs_path($1) . "/"|e;         # get absolute pathname
 118
 119         my $filename_noext = $full_filename;
 120         $filename_noext =~ s/\\/\\\\/g; # escape \
 121         $filename_noext =~ s/_/\\_/g;   # and _
 122         $filename_noext =~ s/%/\\%/g;   # and %
 123
 124         my $sth = $dbh->prepare(
 125                 "SELECT song.id,title,artist.name,album.name,track,length," .
 126                 "lyrics,language,description,uuid FROM song " .
 127                 "LEFT JOIN album ON album.id=song.album_id " .
 128                 "LEFT JOIN artist ON artist.id=song.artist_id " .
 129                 "LEFT JOIN lyrics ON lyrics.id=song.id " .
 130                 "WHERE present AND filename LIKE ?");
 131
 132         my $partial = 0;
 133         for(;;) {
 134                 $sth->execute($filename_noext)
 135                         or die "can't do sql command: " . $dbh->errstr;
 136                 ($id, $ti, $ar, $al, $tr, $len, $lyrics, $language, $description, $uuid) =
 137                         $sth->fetchrow_array and last;
 138
 139                 $partial++;
 140                 if($partial == 1) {
 141                         # replace extension by .% wildcard
 142                         $filename_noext =~ s|\.[^/.]+$|.%|;
 143                 } else {
 144                         # replace first pathname component by %/
 145                         $filename_noext =~ s|^%?/+[^/]+/+|%/| or do {
 146                                 warn "$f: not found in dbase\n" unless $opt_q;
 147                                 return 1;
 148                         };
 149                 }
 150         }
 151         $sth->finish;
 152         $partial and warn "$f: partial filename match on $filename_noext\n" unless $opt_q;
 153
 154         next unless -s $f;
 155
 156         if($f =~ /\.mp[123]$/i) {
 157                 do_mp3($dbh, $f, $ar, $ti, $al, $tr, $len, $lyrics, $description, $language, $uuid);
 158         } elsif($f =~ /\.flac$/i) {
 159                 do_flac($dbh, $f, $ar, $ti, $al, $tr, $len);
 160         } elsif($f =~ /\.ogg$/i) {
 161                 do_ogg($dbh, $f, $ar, $ti, $al, $tr, $len);
 162         } else {
 163                 warn "unknown file type: $f\n";
 164         }
 165
 166         if($opt_r) {
 167                 my $ext = "";
 168                 $f =~ /.*\.(.*?)$/ and $ext = lc($1);
 169                 my $newname = "";
 170                 $newname .= sprintf "%02d-", $tr if $tr;
 171                 $newname .= string_to_filename($ar) . "-" if $ar;
 172                 $newname .= string_to_filename($ti);
 173                 $newname =~ s/--+/-/;
 174                 if($opt_l && length("$newname.$ext") > $opt_l) {
 175                         $newname = substr($newname, 0, $opt_l - length(".$ext") - 1);
 176                         $newname =~ s/_?$/_/;
 177                 }
 178                 $newname .= ".$ext";
 179                 $full_filename =~ m|^(.*)/|;
 180                 $newname = "$1/$newname";
 181
 182                 if($newname ne $full_filename) {
 183                         warn "renaming $full_filename -> $newname\n";
 184                         if(-e $newname) {
 185                                 warn "$f: $newname exists, skipping\n";
 186                         } elsif(!$opt_t) {
 187                                 if(rename $full_filename, $newname) {
 188                                         $dbh->do("DELETE FROM song WHERE filename=?",
 189                                                 undef, $newname)
 190                                                 or die "can't do sql command: " . $dbh->errstr;
 191                                         $dbh->do("UPDATE song SET filename=? WHERE id=?",
 192                                                 undef, $newname, $id)
 193                                                 or die "can't do sql command: " . $dbh->errstr;
 194                                 } else {
 195                                         warn "rename $full_filename -> $newname: $!\n";
 196                                 }
 197                         }
 198                 }
 199         }
 200         return 1;
 201 }
 202
 203 sub do_mp3($$$$$$$$$) {
 204         my ($dbh, $f, $ar, $ti, $al, $tr, $len, $lyrics, $lyrdesc, $lyrlang, $uuid) = @_;
 205
 206         if(!$opt_1) {
 207                 local *F;
 208                 open F, "+<$f" or do {
 209                         warn "$f: $!\n";
 210                         return 1;
 211                 };
 212                 for(;;) {
 213                         my $buf;
 214
 215                         seek F, -128, 2;
 216                         read F, $buf, 128;
 217                         $buf =~ /^TAG/ or last;
 218                         warn "$f: removed ID3 tag\n";
 219                         seek F, -128, 2;
 220                         truncate F, tell F or warn "truncate $f: $!\n"
 221                                 unless $opt_t;
 222                         last if $opt_t;
 223                 }
 224                 close F;
 225         }
 226
 227         $mp3 = MP3::Tag->new($f) or die "$f: $!\n";
 228         $mp3->config("autoinfo", "ID3v2");
 229         my ($p_ti, $p_tr, $p_ar, $p_al) = $mp3->autoinfo();
 230         my $p_uslt;
 231         my ($p_ufidname, $p_uuid);
 232         my $p_len = 0;
 233         my $newtag = $mp3->{ID3v2};
 234         if(defined($newtag)) {
 235                 $newtag->remove_frame('TIT2');
 236                 $newtag->remove_frame('TPE1');
 237                 $newtag->remove_frame('TALB');
 238                 $newtag->remove_frame('TRCK');
 239                 $p_len = $mp3->{ID3v2}->getFrame('TLEN');
 240                 $newtag->remove_frame('TLEN');
 241                 $p_uslt = $mp3->{ID3v2}->getFrame('USLT');
 242                 $newtag->remove_frame('USLT');
 243                 ($p_ufid) = $mp3->{ID3v2}->getFrame('UFID');
 244                 if($p_ufid->{Text} eq "UUID") { $p_uuid = $p_ufid->{_Data}; }
 245                 $newtag->remove_frame('UFID');
 246                 #warn Dumper($p_uslt);
 247         } else {
 248                 $newtag = $mp3->newTag('ID3v2');
 249         }
 250         if($opt_f || $p_ti ne $ti || $p_tr != $tr || $p_ar ne $ar || $p_al ne $al ||
 251                 $p_len != 1000 * $len || $p_uslt->{Description} ne $lyrdesc ||
 252                 ($lyrics && $p_uslt->{Language} ne $lyrlang) ||
 253                 $p_uslt->{Text} ne $lyrics || $p_uuid ne $uuid) {
 254
 255                 $newtag->add_frame('TIT2', $ti) if $ti;
 256                 $newtag->add_frame('TPE1', $ar) if $ar;
 257                 $newtag->add_frame('TALB', $al) if $al;
 258                 $newtag->add_frame('TRCK', $tr) if $tr;
 259                 if($len) {
 260                         $newtag->add_frame('TLEN', 1000 * $len);
 261                 }
 262                 if($lyrics) {
 263                         $newtag->add_frame('USLT', 0, $lyrlang, $lyrdesc, $lyrics);
 264                 }
 265                 if($uuid) {
 266                         $newtag->add_frame('UFID', "UUID", $uuid);
 267                 }
 268                 warn "$f: updating ID3v2 tag\n";
 269                 $newtag->write_tag()
 270                         unless $opt_t;
 271         }
 272         if($opt_1) {
 273                 $ti =~ s/^(.{29}).{2,}/$1_/;
 274                 $ar =~ s/^(.{29}).{2,}/$1_/;
 275                 $al =~ s/^(.{29}).{2,}/$1_/;
 276                 my $id3v1 = $mp3->{ID3v1};
 277                 if(defined($id3v1)) {
 278                         if($id3v1->song eq $ti &&
 279                            $id3v1->artist eq $ar &&
 280                            $id3v1->album eq $al &&
 281                            $id3v1->track == $tr) { $id3v1 = undef; }
 282                 } else {
 283                         $id3v1 = $mp3->newTag('ID3v1');
 284                 }
 285                 if(defined($id3v1)) {
 286                         $id3v1->song($ti);
 287                         $id3v1->artist($ar);
 288                         $id3v1->album($al);
 289                         $id3v1->track($tr);
 290                         warn "$f: updating ID3 tag\n";
 291                         $id3v1->writeTag;
 292                 }
 293         }
 294         return 1;
 295 }
 296
 297 sub do_ogg($$$$$$$) {
 298         my ($dbh, $f, $ar, $ti, $al, $tr, $len) = @_;
 299         local *FR;
 300         local *FW;
 301
 302         # read current tags & see what needs to be changed
 303         my $needchange = 0;
 304         if(open(FR, "-|") == 0) {
 305                 exec "vorbiscomment", "-ql", $f;
 306                 die "vorbiscomment";
 307         }
 308         while(<FR>) {
 309                 s/\s+$//;
 310                 if((/^artist=(.*)/ && $1 ne $ar) ||
 311                    (/^title=(.*)/ && $1 ne $ti) ||
 312                    (/^album=(.*)/ && $1 ne $al) ||
 313                    (/^tracknumber=(.*)/ && $1 != $tr)) {
 314                         $needchange = 1;
 315                         last;
 316                 }
 317         }
 318         close FR;
 319
 320         $needchange or return 1;
 321         warn "$f: updating vorbis comments\n";
 322         return 1 if $opt_t;
 323
 324         if(open(FR, "-|") == 0) {
 325                 exec "vorbiscomment", "-ql", $f;
 326                 die "vorbiscomment";
 327         }
 328         if(open(FW, "|-") == 0) {
 329                 exec "vorbiscomment", "-qw", $f;
 330                 die "vorbiscomment";
 331         }
 332         # print new info
 333         print FW <<EOF;
 334 artist=$ar
 335 title=$ti
 336 album=$al
 337 tracknumber=$tr
 338 EOF
 339         # copy other tags verbatim
 340         while(<FR>) {
 341                 next if /^(artist|title|album|tracknumber)=/;
 342                 print FW $_;
 343         }
 344         close FR;
 345         close FW;
 346         return 1;
 347 }
 348
 349 sub do_flac($$$$$$$) {
 350         my ($dbh, $f, $ar, $ti, $al, $tr, $len) = @_;
 351         local *F;
 352
 353         # read current tags & see what needs to be changed
 354         my @changeargs = ();
 355         if(open(F, "-|") == 0) {
 356                 exec "metaflac", "--export-vc-to=-", $f;
 357                 die "metaflac";
 358         }
 359         while(<F>) {
 360                 s/\s+$//;
 361                 if($opt_f || (/^artist=(.*)/ && $1 ne $ar)) {
 362                         push @changeargs, "--remove-vc-field=artist", "--set-vc-field=artist=$ar";
 363                 } elsif($opt_f || (/^title=(.*)/ && $1 ne $ti)) {
 364                         push @changeargs, "--remove-vc-field=title", "--set-vc-field=title=$ti";
 365                 } elsif($opt_f || (/^album=(.*)/ && $1 ne $al)) {
 366                         push @changeargs, "--remove-vc-field=album", "--set-vc-field=album=$al";
 367                 } elsif($opt_f || (/^tracknumber=(.*)/ && $1 != $tr)) {
 368                         push @changeargs, "--remove-vc-field=tracknumber", "--set-vc-field=tracknumber=$tr";
 369                 }
 370         }
 371         close F;
 372
 373         # change it
 374         if(@changeargs) {
 375                 warn "$f: updating vorbis comments\n";
 376                 if(!$opt_t) { system "metaflac", @changeargs, $f; }
 377         }
 378         return 1;
 379 }
 380
 381
 382 getopts('rfhqtl:c:1');
 383
 384 read_configfile(\%conf, $opt_c);
 385
 386 ($prog = $0) =~ s|.*/||;
 387 if($opt_h || !@ARGV) {
 388         print <<EOF;
 389 Usage: $prog [-hrqft] [-l len] mp3files...
 390
 391 Options:
 392        -r      : rename files.
 393        -q      : don't warn about partial/failed filename matches.
 394        -f      : force tag writing
 395        -t      : testmode, don't actually write any tags.
 396        -l len  : restrict length of filenames to 'len'
 397        -1      : also write ID3 tag
 398
 399 $prog reads Artist/Title/Album/Track info from the SoepkipTNG
 400 database and writes it to the specified files using ID3v2 (unless the files
 401 already have ID3v2 tags containing the exact same info). All ID3v1 tags are
 402 removed.
 403
 404 If the -r switch is used, the files are renamed to a standard format:
 405 track-artist-title.mp3 (if there is a track number) or artist-title.mp3
 406 (if there is no track number).
 407 * track consists of two or more digits.
 408 * artist may contain only alphanumeric characters and underscores.
 409 * title may contain only alphanumeric characters, underscores and dashes.
 410
 411 EOF
 412         exit;
 413 }
 414
 415 $| = 1;
 416
 417 my $dbh = DBI->connect("DBI:$conf{'db_type'}:$conf{'db_name'}:$conf{'db_host'}",
 418         $conf{'db_user'}, $conf{'db_pass'})
 419         or die "can't connect to database";
 420
 421 foreach $f (@ARGV) {
 422         if(-d $f) {
 423                 do_dir($dbh, $f);
 424         } elsif(-s _) {
 425                 do_file($dbh, $f);
 426         }
 427 }
 428
 429 $dbh->disconnect();