soepkiptng_update

   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 strict;
  39 use DBI;
  40 use Encode;
  41 use Getopt::Std;
  42 use MP3::Tag;
  43 use MP3::Info;
  44 use Data::Dumper;
  45
  46 our $opt_T = 1;
  47 our ($opt_C, $opt_L, $opt_M, $opt_R, $opt_c, $opt_d, $opt_e, $opt_f, $opt_h, $opt_l, $opt_m, $opt_n, $opt_p, $opt_q, $opt_r, $opt_v);
  48
  49 sub get_wav_params($\%;$);
  50 sub getinfo_mp3($\%);
  51 sub getinfo_ogg($\%);
  52 sub getinfo_mid($\%);
  53 sub getinfo_wav($\%);
  54 sub getinfo_flac($\%);
  55 sub getinfo_shorten($\%);
  56 sub getinfo_musepack($\%);
  57 sub getinfo_raw($\%);
  58 sub getinfo_mplayer($\%);
  59 sub getinfo_ac3($\%);
  60 sub getinfo_soepkip($\%);
  61 sub read_eric_files();
  62 sub extract_artist_title($\%);
  63 sub is_nfs($);
  64
  65 $opt_R = 10000;
  66 if(open F, ".soepkiptng_random_pref") {
  67         $opt_R = 0 + <F>;
  68         close F;
  69 }
  70 getopts('Cfredqvhc:LM:R:Tpmln');
  71 my $force = 1 if $opt_f;
  72 $| = 1;
  73 my $do_delete = !$opt_d && !$opt_r;
  74 if($opt_p && scalar @ARGV == 0) { push @ARGV, "."; }
  75 $opt_n = " (not)" if $opt_n;
  76
  77 $opt_h and die <<EOF;
  78 usage: soepkiptng_update [-defhqrvCL] [-c configfile] [-R pref] [dir...]
  79
  80 options:
  81   -C            : don't fix artist/title/album upper/lowercase
  82   -c configfile : override soepkiptng config file
  83   -d            : turn on debugging
  84   -e            : don't read "ericfiles"
  85   -f            : force updating of info even if song is already in database
  86   -h            : get this help
  87   -L            : set last_played to current time
  88   -m            : skip recent files
  89   -M n          : add max N files
  90   -n            : don't actually do anything to the database
  91   -q            : be quiet
  92   -r            : don't recurse subdirectories
  93   -R pref       : set random_pref field
  94   -T            : test file integrity before adding
  95   -v            : be verbose
  96
  97 Directories containing the file ".nosoepkiptng" will be skipped.
  98 EOF
  99
 100 my %conf;
 101 read_configfile(\%conf, $opt_c);
 102
 103
 104 # for the web interface (stupid browsers/users)
 105 $SIG{'PIPE'} = 'IGNORE';
 106
 107 # disable warnings (to make MP3::Tag shut up)
 108 if($opt_q) {
 109         $SIG{__WARN__} = sub { };
 110 }
 111
 112 my $dbh = DBI->connect("DBI:$conf{'db_type'}:$conf{'db_name'}:$conf{'db_host'}", $conf{'db_user'}, $conf{'db_pass'})
 113         or die "can't connect to database";
 114
 115 my (%track, %artist, %album, %tracknr);
 116 read_eric_files() unless $opt_e;
 117
 118 # get existing filenames in database
 119 my $sth;
 120 my @paths;
 121 if(scalar @ARGV) {
 122         @paths = grep { length } map { abs_path $_; } @ARGV;
 123         @paths or exit 1; # abs_path complains for us
 124         $sth = $dbh->prepare("SELECT id,filename,unix_timestamp(last_played)," .
 125                 "unix_timestamp(time_added),present FROM song WHERE (0" .
 126                 (" OR binary filename LIKE ?" x scalar @paths) . ")");
 127         $sth->execute(map { $_ . "%" } @paths);
 128 } else {
 129         $sth = $dbh->prepare("SELECT id,filename,unix_timestamp(last_played),unix_timestamp(time_added),present FROM song WHERE filename LIKE \"/%\"");
 130         $sth->execute();
 131         @paths = split /\s+/, $conf{'mp3dirs'};
 132 }
 133 my (%filename, %last_played, %time_added, %longname, %longname_id);
 134 while(my ($id, $f, $l, $t, $pres) = $sth->fetchrow_array) {
 135         $filename{$f} = $id if $pres;
 136         $last_played{$f} = $l;
 137         $time_added{$f} = $t;
 138         $f =~ m|([^/]*)$|;
 139         $longname{$1} = $f;
 140         $longname_id{$1} = $id;
 141 }
 142
 143 # scan music directories
 144 if(open(FILES, "-|") == 0) {
 145         my @findargs;
 146         $opt_r and push @findargs, '-maxdepth', 1;
 147         exec 'find', @paths, @findargs, '-type', 'f', '-print0';
 148         die "find: $!\n";
 149 }
 150
 151 $/ = "\0";
 152 my ($num_added, $num_updated, $num_deleted, $num_moved, $num_skipped, $endmsg);
 153 my (%artistid_cache, %albumid_cache);
 154 my @files = sort <FILES>;
 155 foreach my $file (@files) {
 156         chop $file;
 157         # skip hidden files
 158         next if $file =~ m|/\.[^/]+$|;
 159         # skip zero-length files
 160         next unless -s $file;
 161         $file =~ m|(.*?)[^/]*$|;
 162         next if -e "$1/.nosoepkiptng";
 163         if($opt_m) {
 164                 my ($mt, $ct) = (stat $file)[9,10];
 165                 if($ct > $mt) { $mt = $ct; }
 166                 if((time - $mt) < 30) {
 167                         warn "skipping $file (too recent)\n";
 168                         next;
 169                 }
 170         }
 171
 172         # skip if already in database (unless "force" was given)
 173         if($filename{$file} && !$force) {
 174                 $num_skipped++;
 175                 delete $filename{$file};
 176                 next;
 177         }
 178
 179         print "$file\n" if $opt_v;
 180
 181         if(length($file) > 255) {
 182                 print STDERR "Skipping $file, filename >255 chars.\n" unless $opt_q;
 183                 next;
 184         }
 185
 186 #       if(++$num % 10 == 0) { print STDERR "."; }
 187
 188         # get file encoding; skip if unknown
 189         my %info;
 190         $/ = "\n";
 191         getinfo_mp3($file, %info) ||
 192         getinfo_ogg($file, %info) ||
 193         getinfo_mid($file, %info) ||
 194         getinfo_wav($file, %info) ||
 195         getinfo_flac($file, %info) ||
 196         getinfo_shorten($file, %info) ||
 197         getinfo_musepack($file, %info) ||
 198         getinfo_mplayer($file, %info) ||
 199         getinfo_ac3($file, %info) ||
 200         getinfo_raw($file, %info);
 201
 202         next if $info{skip};
 203
 204         getinfo_soepkip($file, %info);
 205
 206         $/ = "\0";
 207
 208         $info{len} = 0 + $info{len};
 209         $info{encoding} or do {
 210                 print STDERR "Filetype of $file unknown\n" unless $opt_q;
 211                 next;
 212         };
 213         if($info{freq} && ($info{freq} < 44090 || $info{freq} > 44110)) {
 214                 my $s = sprintf "%f", $info{freq} / 1000;
 215                 $s =~ s/\.?0+$//;
 216                 push @{$info{encoding_extra}}, "${s}kHz";
 217         }
 218         if($info{bps} && ($info{bps} != 16)) {
 219                 push @{$info{encoding_extra}}, sprintf "%dbit", $info{bps};
 220         }
 221         if($info{chan} == 1) {
 222                 push @{$info{encoding_extra}}, "mono";
 223         }
 224         if(exists $info{encoding_extra} && @{$info{encoding_extra}}) {
 225                 $info{encoding} .= sprintf " (%s)", join(", ", @{$info{encoding_extra}});
 226         }
 227
 228         # check "nolocal" setting (only files on NFS are allowed)
 229         if($conf{nolocal} && !is_nfs($file)) {
 230                 die "Error: file on local filesystem: $file\n";
 231         }
 232
 233         if($filename{$file}) {
 234                 print "Updating $file:\n";
 235                 $num_updated++;
 236         } else {
 237                 # check whether an old entry (ie. the file does not exist anymore)
 238                 # exists with the same filename (without path)
 239                 $file =~ /([^\/]*)$/;
 240                 my $oldname = $longname{$1};
 241                 if($oldname && ($oldname eq $file || ! -e $oldname)) {
 242                         if(!$opt_n) {
 243                                 $dbh->do("DELETE FROM song WHERE present=0 AND id!=? AND " .
 244                                         "binary filename=?", undef, $longname_id{$1}, $file)
 245                                         or die "can't do sql command: " . $dbh->errstr . "\n";
 246                                 $dbh->do("UPDATE song SET present=1, filename=?, " .
 247                                         "length=?, encoding=? WHERE id=?", undef,
 248                                         $file, $info{len}, $info{encoding}, $longname_id{$1})
 249                                         or die "can't do sql command: " . $dbh->errstr . "\n";
 250                         }
 251                         delete $filename{$oldname};
 252                         $num_moved++;
 253                         $oldname =~ s|[^/]+$||;
 254                         print "Moving $file (from $oldname)\n";
 255                         next;
 256                 }
 257                 if(defined($opt_M) && $num_added >= $opt_M) {
 258                         print "Skipping $file (max $opt_M adds)\n";
 259                         $num_skipped++;
 260                         delete $filename{$file};
 261                         next;
 262                 }
 263                 $num_added++;
 264                 print "Adding $file:\n";
 265         }
 266
 267         # get artist/title/track/album info
 268         $file =~ m|([^/]+/+[^/]+)\.\w+$|;
 269 #print STDERR "1=$1\n";
 270         if($track{$1}) {
 271                 $info{info_origin} = "ericfile";
 272                 $info{artist} = $artist{$1};
 273                 $info{title} = $track{$1};
 274                 $info{album} = $album{$1};
 275                 $info{track} = $tracknr{$1};
 276         } elsif(!$info{info_origin}) {
 277                 extract_artist_title($file, %info);
 278         } elsif(!$info{title}) {
 279                 my %i;
 280                 extract_artist_title($file, %i);
 281                 $info{title} = $i{title};
 282         }
 283
 284         $info{artist} =~ s/\s*\n\s*/ /g;
 285         $info{album} =~ s/\s*\n\s*/ /g;
 286         $info{title} =~ s/\s*\n\s*/ /g;
 287
 288         if(!$info{track} && $file =~ m~(^|/)(\d\d+)[^/]+$~) {
 289                 $info{track} = $2;
 290                 warn " (taking track ($2) from filename)\n";
 291         }
 292         if(!$info{lyrics}) {
 293                 my $lyrfile = $file;
 294                 if($lyrfile =~ s/\.[^.]+$/.txt/) {
 295                         if(open F, $lyrfile) {
 296                                 warn " (taking lyrics from .txt)\n";
 297                                 my $indent;
 298                                 $info{lyrics} = <F>;
 299                                 $info{lyrics} =~ s/\t/ /g;
 300                                 $info{lyrics} =~ s/ +($)/\1/mg;
 301                                 while($info{lyrics} =~ /^( *)\S/mg) {
 302                                         if(length($1) < $indent || !defined($indent)) {
 303                                                 $indent = length($1);
 304                                         }
 305                                 }
 306                                 $indent = " "x$indent;
 307                                 $info{lyrics} =~ s/(^)$indent/\1/mg;
 308                                 close F;
 309                         }
 310                 }
 311         }
 312
 313         printf <<EOF,
 314    Info from: %s
 315    Artist:    %s
 316    Title:     %s
 317    Album:     %s
 318    Track:     %d
 319    Length:    %d:%02d
 320    Encoding:  %s
 321 EOF
 322         $info{info_origin},
 323         $info{artist},
 324         $info{title},
 325         $info{album},
 326         $info{track},
 327         $info{len} / 60, $info{len} % 60,
 328         $info{encoding};
 329
 330         if(!$opt_n) {
 331                 # insert song into database
 332                 if(!$artistid_cache{$info{artist}}) {
 333                         $artistid_cache{$info{artist}} = get_id($dbh, "artist", $info{artist}) or die;
 334                 }
 335                 if(!$albumid_cache{$info{album}}) {
 336                         $albumid_cache{$info{album}} = get_id($dbh, "album", $info{album});
 337                 }
 338                 my $q = "REPLACE INTO song SET id=?, artist_id=?, title=?, album_id=?, " .
 339                         "track=?, present=1, filename=?, length=?, encoding=?, random_pref=?, " .
 340                         "last_played=from_unixtime(?), time_added=from_unixtime(?)";
 341
 342                 $dbh->do($q, undef, $filename{$file}, $artistid_cache{$info{artist}},
 343                         $info{title}, $albumid_cache{$info{album}}, $info{track} || 0,
 344                         $file, $info{len}, $info{encoding}, $opt_R,
 345                         $last_played{$file} || ($opt_L? time : 0),
 346                         $time_added{$file} || time)
 347                         or die "can't do sql command: " . $dbh->errstr . "\n";
 348
 349                 if($info{lyrics}) {
 350                         $dbh->do("REPLACE INTO lyrics SET id=?, description=?, language=?, lyrics=?",
 351                                 undef, $filename{$file} || $dbh->{'mysql_insertid'},
 352                                 $info{description}, $info{language}, $info{lyrics})
 353                                 or die "can't do sql command: " . $dbh->errstr . "\n";
 354                 }
 355         }
 356         delete $filename{$file};
 357 }
 358
 359 close FILES
 360         or die sprintf "find: %s signal %d\n",
 361                 (($? & 0x7f)? "killed by":"exit status"),
 362                 (($? & 0x7f)? ($? & 0x7f) : ($? >> 8));
 363
 364 # delete all filenames in database what were not found on disk
 365 if($do_delete && !$opt_n) {
 366         $sth = $dbh->prepare("UPDATE song SET present=0 WHERE binary filename=?");
 367         foreach(keys %filename) {
 368                 $sth->execute($_);
 369                 print "Deleting $_\n";
 370                 $num_deleted++;
 371         }
 372 }
 373
 374 printf <<EOF,
 375 %4d songs added$opt_n.
 376 %4d songs updated$opt_n.
 377 %4d songs deleted$opt_n.
 378 %4d songs moved$opt_n.
 379 %4d songs skipped.
 380 EOF
 381         $num_added, $num_updated, $num_deleted, $num_moved, $num_skipped
 382                 unless $opt_q && $num_added == 0 && $num_updated == 0
 383                         && $num_deleted == 0 && $num_moved == 0;
 384 print $endmsg;
 385
 386 print "Optimizing Tables.\n" unless $opt_q;
 387 $dbh->do("optimize table song");
 388 $dbh->do("optimize table album");
 389 $dbh->do("optimize table artist");
 390
 391 $sth->finish();
 392 $dbh->disconnect();
 393
 394
 395 sub get_id3($\%) {
 396         my ($file, $info) = @_;
 397
 398         if($file =~ m|(.*/)| and -e "$1/.noid3") { return undef; }
 399
 400         my $id3 = MP3::Tag->new($file);
 401         $id3->config("autoinfo", "ID3v2", "ID3v1");
 402         my ($t, $tr, $a, $alb) = $id3->autoinfo();
 403
 404         # read lyrics
 405         my $tag = $id3->{ID3v2};
 406         if($tag) {
 407                 my $uslt = $tag->getFrame('USLT');
 408                 if($uslt) {
 409                         $info->{language} = $uslt->{Language};
 410                         $info->{lyrics} = $uslt->{Text};
 411                         $info->{description} = $uslt->{Description};
 412                 }
 413         }
 414
 415         $a =~ s/_/ /g;
 416         $a =~ s/([^'\w\xc0-\xff]|^)(\w)(\S*)\b/\1\U\2\L\3/g unless $a =~ /[A-Z]/ || $opt_C;
 417         $t =~ s/_/ /g;
 418         $t =~ s/([^'\w\xc0-\xff]|^)(\w)(\S*)\b/\1\U\2\L\3/g unless $t =~ /[A-Z]/ || $opt_C;
 419         $alb =~ s/_/ /g;
 420         $alb =~ s/([^'\w\xc0-\xff]|^)(\w)(\S*)\b/\1\U\2\L\3/g unless $alb =~ /[A-Z]/ || $opt_C;
 421
 422         $a && $t or return undef;
 423
 424         $info->{info_origin} = $id3->{ID3v2}? "ID3v2" : "ID3";
 425         $info->{artist} = $a;
 426         $info->{title} = $t;
 427         $info->{album} = $alb || "";
 428         $info->{track} = $tr;
 429         return 1;
 430 }
 431
 432 # used by musepack; see http://www.personal.uni-jena.de/~pfk/mpp/sv8/apetag.html
 433 sub get_ape($\%$) {
 434         my ($file, $info, $offset) = @_;
 435         local *F;
 436         my $apetag;
 437         my $found;
 438
 439         open F, $file or return undef;
 440         seek F, $offset, ($offset < 0? 2 : 0) or goto OUT;
 441         read F, $apetag, 32 or goto OUT;
 442         $apetag =~ /^APETAGEX/ or goto OUT;
 443         my ($version, $length, $tagcount, $flags) = unpack "VVVV", substr $apetag, 8;
 444         $version == 1000 || $version == 2000 or goto OUT;
 445         $length > 32 or goto OUT;
 446         unless(($flags >> 29) & 1) {
 447                 seek F, -$length, 1 or goto OUT;
 448         }
 449         read F, $apetag, $length - 32 or goto OUT;
 450         my ($pos, $tag);
 451         for($pos = 0, $tag = 0; $pos < $length && $tag < $tagcount; $tag++) {
 452                 my ($len, $fl, $name) = unpack "VVZ*", substr $apetag, $pos;
 453                 $pos += 8 + length($name) + 1;
 454                 if($name =~ /^(Artist|Title|Album|Track)$/) {
 455                         $info->{lc $1} = substr $apetag, $pos, $len;
 456                         $found++;
 457                 }
 458                 $pos += $len;
 459         }
 460         $found or goto OUT;
 461         $info->{info_origin} = sprintf "APE %d.0", $version / 1000;
 462 OUT:
 463         close F;
 464         return $found;
 465 }
 466
 467 # getinfo_* returns (description, length[sec], sfreq[khz], channels
 468 # or undef if it isn't the correct type
 469
 470 sub getinfo_mp3($\%) {
 471         my ($file, $info) = @_;
 472
 473         $file =~ /\.mp[1-3]$/i
 474                 or return undef;
 475
 476         # open file to check Xing VBR tag
 477         open STDIN, $file or do {
 478                 print STDERR "$file: $!\n";
 479                 $info->{skip} = 1;
 480                 return "?";
 481         };
 482
 483         # skip ID3 tag
 484         my $buf;
 485         read STDIN, $buf, 10;
 486         my ($tag, $ver1, $ver2, $flags, $s1, $s2, $s3, $s4) = unpack "a3CCCCCCC", $buf;
 487         if($tag eq "ID3") {
 488                 my $size = (((((($s1 << 7) | $s2) << 7) | $s3) << 7) | $s4) + 10;
 489                 seek STDIN, $size, 1;
 490         }
 491
 492         # read Xing VBR tag
 493         seek STDIN, 26, 1;
 494         read STDIN, $buf, 12;
 495
 496         my ($xtag, $xflags, $xframes);
 497         ($xtag, $xflags, $xframes) = unpack("a4NN", $buf);
 498         if($xtag ne "Xing") { $xframes = 0; }
 499
 500         my $mp3info = get_mp3info($file);
 501         $info->{len} = $mp3info->{MM} * 60 + $mp3info->{SS};
 502         $info->{freq} = $mp3info->{FREQUENCY} * 1000;
 503         $info->{chan} = $mp3info->{STEREO}? 2 : 1;
 504
 505         my $bitrate = $mp3info->{BITRATE};
 506         if($xframes) {
 507                 $info->{len} = $xframes * ($mp3info->{VERSION}? 1152 : 576) /
 508                         $info->{freq};
 509                 $bitrate = int(8 * (-s $file) / $info->{len} / 1000);
 510         }
 511         if($opt_l) {
 512                 seek STDIN, 0, 0;
 513                 open F, "mp3_check -|";
 514                 while(my $l = <F>) {
 515                         if($l =~ /^SONG_LENGTH\s+(\d+):(\d+)/) {
 516                                 $info->{len} = $1 * 60 + $2;
 517                         }
 518                         if($l =~ /^VBR_AVERAGE\s+(\d+)/) {
 519                                 $bitrate = $1;
 520                         }
 521                 }
 522                 close F;
 523         }
 524         if($mp3info->{LAYER} == 3) {
 525                 $info->{encoding} = "MP3";
 526         } else {
 527                 $info->{encoding} = sprintf "MPEG-%d Layer %d",
 528                         $mp3info->{VERSION}, $mp3info->{LAYER};
 529         }
 530         push @{$info->{encoding_extra}}, sprintf("%dkb/s", $bitrate);
 531         if($xframes) { push @{$info->{encoding_extra}}, "VBR"; }
 532
 533         get_id3($file, %$info);
 534
 535         close STDIN;
 536         return 1;
 537 }
 538
 539 sub getinfo_ogg($\%) {
 540         my ($file, $info) = @_;
 541         local *F;
 542
 543         $file =~ /\.ogg$/i
 544                 or return undef;
 545
 546         if(open(F, "-|") == 0) {
 547                 exec "ogginfo", $file;
 548                 die;
 549         }
 550         my $br;
 551         while(<F>) {
 552                 s/\s+$//;
 553                 if(/^Rate:\s*(\d+)/i) {
 554                         $info->{freq} = $1;
 555                 } elsif(/^Channels:\s*(\d+)/) {
 556                         $info->{chan} = $1;
 557                 } elsif(/^\s+Playback length:\s*(\d+)m:(\d+)/i) {
 558                         $info->{len} = $1 * 60 + $2;
 559                 } elsif(/^\s+Average bitrate:\s*(\d+(\.\d+)?)/i) {
 560                         $br = int($1 + 0.5);
 561                 } elsif(/^\s+artist=(.*)/) {
 562                         $info->{artist} = $1;
 563                 } elsif(/^\s+title=(.*)/) {
 564                         $info->{title} = $1;
 565                 } elsif(/^\s+album=(.*)/) {
 566                         $info->{album} = $1;
 567                 } elsif(/^\s+tracknumber=(.*)/) {
 568                         $info->{track} = $1;
 569                 }
 570         }
 571         close F;
 572         $info->{freq} or return undef;
 573         $info->{encoding} = "Ogg-Vorbis";
 574         push @{$info->{encoding_extra}}, sprintf("%dkb/s", $br);
 575         $info->{info_origin} = "Ogg-Vorbis" if $info->{artist} && $info->{title};
 576         return 1;
 577 }
 578
 579 sub getinfo_wav($\%) {
 580         my ($file, $info) = @_;
 581
 582         $file =~ /\.wav$/i
 583                 or return undef;
 584
 585         get_wav_params($file, %$info) or return undef;
 586         return 1;
 587 }
 588
 589 sub getinfo_mid($\%) {
 590         my ($file, $info) = @_;
 591
 592         $file =~ /\.(mid|rcp|r36|g18|g36|mod)$/i
 593                 or return undef;
 594
 595         $info->{encoding} = "Midi";
 596         return 1;
 597 }
 598
 599 sub check_gap_flac($$) {
 600         my ($file, $bitspersample) = @_;
 601         local *F;
 602         if(open(F, "-|") == 0) {
 603                 open STDERR, ">/dev/null";
 604                 exec "metaflac", "--list", $file;
 605                 die;
 606         }
 607         my ($lastoff, $lastbyteoff);
 608         while(<F>) {
 609                 my ($off, $byteoff) = /\s+point \d+: sample_number=(\d+), stream_offset=(\d+)/
 610                         or next;
 611                 if(defined($lastoff)) {
 612                         last if $byteoff == 0;
 613                         my $comp = ($byteoff - $lastbyteoff) / ($off - $lastoff) * 8 / $bitspersample;
 614                         if($comp < 0.01) {
 615                                 $endmsg .= "$file seems to have gaps!\n";
 616                                 last;
 617                         }
 618                 }
 619                 ($lastoff, $lastbyteoff) = ($off, $byteoff);
 620         }
 621         close F;
 622 }
 623
 624 sub getinfo_flac($\%) {
 625         my ($file, $info) = @_;
 626
 627         $file =~ /\.flac$/i
 628                 or return undef;
 629
 630         my $filesize = -s $file or return undef;
 631
 632         if($opt_T) {
 633                 my $output;
 634                 local *FL;
 635                 if(open(FL, "-|") == 0) {
 636                         open STDERR, ">&STDOUT";
 637                         exec "flac", "-st", $file;
 638                         die "flac: $!\n";
 639                 }
 640                 my $last;
 641                 while(<FL>) {
 642                         next if $_ eq $last;
 643                         $output .= $_;
 644                         $last = $_;
 645                 }
 646                 close FL;
 647                 if($?) {
 648                         if($output =~ /^(.*error.*)$/im) {
 649                                 warn "$file: integrity test failed, ignoring ($1)\n";
 650                         } else {
 651                                 print STDERR $output;
 652                                 warn "$file: integrity test failed, ignoring\n";
 653                         }
 654                         return $info->{skip} = 1;
 655                 }
 656         }
 657
 658         if(open(F, "-|") == 0) {
 659                 open STDERR, ">/dev/null";
 660                 exec qw/metaflac
 661                         --show-sample-rate
 662                         --show-channels
 663                         --show-total-samples
 664                         --show-bps
 665                         --show-tag=artist
 666                         --show-tag=title
 667                         --show-tag=tracknumber
 668                         --show-tag=album
 669                         /, $file;
 670                 die;
 671         }
 672         my ($totsamp, @rest, @a);
 673         ($info->{freq}, $info->{chan}, $totsamp, $info->{bps}, @rest) = <F>;
 674         close F;
 675         foreach(@rest) {
 676                 if(s/^title=(.*\S)//i) { $info->{title} = $1; }
 677                 elsif(s/^tracknumber=(.*\S)//i) { $info->{track} = $1; }
 678                 elsif(s/^album=(.*\S)//i) { $info->{album} = $1; }
 679                 elsif(s/^artist=(.*\S)//i) { push @a, $1; }
 680         }
 681         $info->{artist} = join " & ", @a;
 682
 683         my $totbytes = $totsamp * $info->{chan} * $info->{bps} / 8;
 684         $info->{encoding} = "flac" . ($totbytes? sprintf(" (%d%%)", 100 * $filesize / $totbytes) : "");
 685         $info->{len} = $info->{freq}? $totsamp / $info->{freq} : 0;
 686         $info->{info_origin} = "flac" if $info->{artist} && $info->{title};
 687         check_gap_flac($file, $info->{chan} * $info->{bps});
 688         return 1;
 689 }
 690
 691 sub getinfo_shorten($\%) {
 692         my ($file, $info) = @_;
 693
 694         $file =~ /\.shn$/i
 695                 or return undef;
 696
 697         $info->{encoding} = "Shorten";
 698         $info->{len} = 0;
 699         $info->{freq} = 44100;
 700         $info->{chan} = 2;
 701         return 1;
 702 }
 703
 704 # handles only SV7
 705 sub getinfo_musepack($\%) {
 706         my ($file, $info) = @_;
 707         my ($buf, $id3);
 708         local *F;
 709
 710         $file =~ /\.mp[cp+]$/i
 711                 or return undef;
 712         open F, $file or do {
 713                 warn "$file: $!\n";
 714                 return undef;
 715         };
 716         read F, $buf, 12;
 717         seek F, -128, 2;
 718         read F, $id3, 128;
 719         close F;
 720         $buf =~ /^MP\+/ or return undef;
 721         my ($version, $frames, $flags) = unpack "VVV", $buf;
 722         $version >>= 24;
 723         if($version != 7) {
 724                 warn "$_: unknown version: SV$version\n";
 725                 return undef;
 726         }
 727         $info->{encoding} = "Musepack";
 728         $info->{freq} = (44100, 48000, 37800, 32000)[($flags >> 16) & 3];
 729         $info->{len} = $frames * 1152 / $info->{freq};
 730         push @{$info->{encoding_extra}}, sprintf "%dkb/s", (8 * (-s $file) / $info->{len} + 500) / 1000;
 731         $info->{chan} = 2;
 732
 733         get_ape($file, %$info, 0) ||      # APE tag at beginning
 734         get_ape($file, %$info, -32) ||    # APE tag at end
 735         get_ape($file, %$info, -160) ||   # APE tag at end followed by ID3 tag
 736         get_id3($file, %$info);
 737         return 1;
 738 }
 739
 740 sub getinfo_raw($\%) {
 741         my ($file, $info) = @_;
 742
 743         $file =~ /\.raw$/i
 744                 or return undef;
 745
 746         $info->{encoding} = "raw";
 747         $info->{len} = (-s $file) / 176400;
 748         $info->{freq} = 44100;
 749         $info->{chan} = 2;
 750         return 1;
 751 }
 752
 753 sub getinfo_mplayer($\%) {
 754         my ($file, $info) = @_;
 755         local $_;
 756         my %prop;
 757
 758         $file =~ /\.(mpe?g|avi|asx|asf|vob|wmv|ra?m|ra|mov|m2v|wma|aac|m4a|m4b|mp4|flv|ape|aiff?)$/i
 759                 or return undef;
 760
 761         local *F;
 762         if(open(F, "-|") == 0) {
 763                 open STDIN, "/dev/null";
 764                 open STDERR, ">&STDOUT";
 765                 delete $ENV{DISPLAY};
 766                 exec qw"mplayer -identify -vo null -ao null -frames 0", $file;
 767                 die "mplayer";
 768         }
 769         while(<F>) {
 770                 s/\s+$//;
 771                 /^\s+author:\s*(.*)/i       and $info->{artist} = $1;
 772                 /^\s+(name|title):\s*(.*)/i and $info->{title} = $2;
 773                 /^\s+album:\s*(.*)/i        and $info->{album} = $1;
 774                 /^\s+track:\s*(\d+)/i       and $info->{track} = $1;
 775                 /^ID_(\w+)=(.*)/ and $prop{lc($1)} = $2;
 776         }
 777         close F;
 778         if($file =~ /\.(ra?m|ra)$/i) {
 779                 $info->{encoding} = $prop{video_format}? "RealVideo":"RealAudio";
 780         } else {
 781                 $info->{encoding} = ($prop{video_format}? "Video: ":"") . $1;
 782         }
 783         $info->{info_origin} = "Clip Info" if $info->{artist} || $info->{title};
 784         if($prop{video_width} && $prop{video_height}) {
 785                 $info->{encoding} .= " ($prop{video_width}x$prop{video_height})";
 786         }
 787         if($prop{video_format}) {
 788                 push @{$info->{encoding_extra}}, sprintf("%s+%skb/s",
 789                         $prop{video_bitrate}? int(($prop{video_bitrate} + 500) / 1000) : "?",
 790                         $prop{audio_bitrate}? int(($prop{audio_bitrate} + 500) / 1000) : "?");
 791                 $info->{freq} = 0;
 792                 $info->{chan} = 0;
 793         } else {
 794                 # audio only
 795                 if($prop{audio_format} >= 0x160 && $prop{audio_format} <= 0x163) {
 796                         my $wma = $prop{audio_format} - 0x160 + 1;
 797                         $wma = 3 if $wma == 4;
 798                         $info->{encoding} = "WMA$wma";
 799                 } elsif($prop{audio_format} eq "mp4a") {
 800                         $info->{encoding} = "AAC";
 801                 } elsif($prop{audio_format} eq "twos" && $file =~ /\.aiff?$/i) {
 802                         $info->{encoding} = "AIFF";
 803                         delete $prop{audio_bitrate};
 804                 } elsif($prop{audio_format} eq "alac" || $prop{audio_format} eq "APE") {
 805                         $info->{encoding} = uc $prop{audio_format};
 806                         my $uncompbytes = $prop{length} * $prop{audio_rate} * $prop{audio_nch} * 2;
 807                         if($uncompbytes) {
 808                                 $info->{encoding} .= sprintf " (%d%%)", 100 * (-s $file) / $uncompbytes;
 809                         }
 810                 }
 811                 push @{$info->{encoding_extra}}, sprintf("%dkb/s", ($prop{audio_bitrate} + 500) / 1000)
 812                         if $prop{audio_bitrate};
 813                 $info->{freq} = $prop{audio_freq};
 814                 $info->{chan} = $prop{audio_nch};
 815         }
 816         if(exists $info->{encoding_extra} && @{$info->{encoding_extra}} == 1 && ${$info->{encoding_extra}}[0] =~ m|115\d\+224kb/s|) {
 817                 if($info->{encoding} =~ s/mpg \(352x288\)/VCD (PAL)/ ||
 818                    $info->{encoding} =~ s/mpg \(352x240\)/VCD (NTSC)/) {
 819                         delete $info->{encoding_extra};
 820                 }
 821         }
 822         $info->{len} = $prop{length};
 823         return 1;
 824 }
 825
 826 sub getinfo_ac3($\%) {
 827         my ($file, $info) = @_;
 828
 829         $file =~ /\.(ac3)$/i
 830                 or return undef;
 831
 832         $info->{encoding} = "AC3";
 833         $info->{freq} = 0;
 834         $info->{chan} = 0;
 835         $info->{len} = 0;
 836         return 1;
 837 }
 838
 839 sub getinfo_soepkip($\%) {
 840         my ($file, $info) = @_;
 841         local *F;
 842
 843         $file =~ s|(.*)/+||;
 844         my $dir = $1;
 845
 846         open F, "$dir/.soepkiptng_info" or return undef;
 847         local $_;
 848         FILE: while(<F>) {
 849                 if(/^\[(.+)\]/ && $1 eq $file) {
 850                         $info->{info_origin} = ".soepkiptng_info";
 851                         while(<F>) {
 852                                 last FILE if /^\[/;
 853                                 s/\s+$//;
 854                                 /^(artist|album|track|title)\s*=\s*(.*)/
 855                                         and $info->{$1} = $2;
 856                         }
 857                         close F;
 858                         return 1;
 859                 }
 860         }
 861         close F;
 862         return undef;
 863 }
 864
 865 # returns samplefreq, channels, seconds
 866 sub get_wav_params($\%;$) {
 867         my ($file, $info, $offset) = @_;
 868         $offset = 0 + $offset;
 869         local *F;
 870         my $buf;
 871
 872         open F, $file or return undef;
 873         FILE: for(;;) {
 874                 if($offset) { read(F, $buf, $offset) or last; }
 875                 read(F, $buf, 12)  or last;
 876                 my ($riff, $len, $wave) = unpack("a4Va4", $buf);
 877                 last if $riff ne 'RIFF' || $wave ne 'WAVE';
 878
 879                 # find 'fmt ' chunk
 880                 my ($type, $len);
 881                 for(;;) {
 882                         read(F, $buf, 8) or last FILE;
 883                         ($type, $len) = unpack("a4V", $buf);
 884                         last if $type eq 'fmt ';
 885                         my $i = 0;
 886                         while($i < $len) {
 887                                 my $r = $len < 4096? $len : 4096;
 888                                 $r = read F, $buf, $r or last FILE;
 889                                 $i += $r;
 890                         }
 891                 }
 892                 read(F, $buf, $len)  or last;
 893                 my ($fmt, $chan, $freq, $bytespersec, $align, $bitspersample, $cbsize, $validbitspersample, undef, $subfmt, $subguid) =
 894                         unpack("vvVVvvvvVva14", $buf);
 895                 #print STDERR "fmt=$fmt ch=$chan f=$freq byps=$bytespersec al=$align bps=$bitspersample cb=$cbsize sfmt=$subfmt\n";
 896                 if($len >= 18 && $fmt == 0xfffe && $cbsize == 22 && $subguid eq "\x00\x00\x00\x00\x10\x00\x80\x00\x00\xAA\x00\x38\x9B\x71") {
 897                         $bitspersample = $validbitspersample;
 898                         $fmt = $subfmt;
 899                 }
 900                 my $encoding = "WAV";
 901                 if($fmt == 3)    { $encoding .= " (float)"; }
 902                 elsif($fmt == 6) { $encoding .= " (A-law)"; }
 903                 elsif($fmt == 7) { $encoding .= " (µ-law)"; }
 904                 elsif($fmt != 1) { $encoding .= sprintf " (fmt %d)", $fmt; }
 905
 906                 # find 'data' chunk
 907                 for(;;) {
 908                         read(F, $buf, 8) or last FILE;
 909                         ($type, $len) = unpack("a4V", $buf);
 910                         last if $type eq 'data';
 911                         while($len) {
 912                                 my $r = $len < 4096? $len : 4096;
 913                                 $r = read F, $buf, $r or last FILE;
 914                                 $len -= $r;
 915                         }
 916                 }
 917                 close F;
 918                 $info->{len} = int($len / $bytespersec + 0.5);
 919                 $info->{freq} = $freq;
 920                 $info->{chan} = $chan;
 921                 $info->{bps} = $bitspersample;
 922                 $info->{encoding} = $encoding;
 923                 return 1;
 924         }
 925         close F;
 926         return undef;
 927 }
 928
 929 sub read_eric_files() {
 930         foreach my $file (split /\s+/, $conf{'description_files'}) {
 931                 my ($artist, $album, $dirname);
 932                 open ALB, $file or die "$file: $!\n";
 933                 while(<ALB>) {
 934                         /\S/ or do { $artist = $album = $dirname = ""; next; };
 935                         /^artist\s*(.*?)\s*$/ and do { $artist = $1; next; };
 936                         /^title\s*(.*?)\s*$/ and do { $album = $1; next; };
 937                         if(/^dirname\s+(.*\S)/) {
 938                                 my $realartist;
 939
 940                                 $dirname = $1;
 941                                 (my $artist_s = $dirname) =~ s/-.*//;
 942                                 while(<ALB>) {
 943                                         /^##\s*(.*\S)/ and do {
 944                                                 $realartist = $1;
 945                                                 next;
 946                                         };
 947                                         if(s/^track\s+(\S+)\.\w+\s*//) {
 948                                                 my $a = $1;
 949                                                 my $filename = $1;
 950                                                 $a =~ s/^(\d+)-([^-]+)-.*/\2/;
 951                                                 $tracknr{"$dirname/$filename"} = $1;
 952                                                 #print STDERR "a=$a artist_s=$artist_s artist=$artist realartist=$realartist\n";
 953                                                 if($realartist) {
 954                                                         $artist{"$dirname/$filename"} = $realartist;
 955                                                         $realartist = undef;
 956                                                 } elsif($a eq $artist_s) {
 957                                                         $artist{"$dirname/$filename"} = $artist;
 958                                                 } else {
 959                                                         $a =~ s/_/ /g;
 960                                                         $a =~ s/\b(\w)/\U\1/g;
 961                                                         $artist{"$dirname/$filename"} = $a;
 962                                                 }
 963                                                 s/\s*$//;
 964                                                 if(!$_) {
 965                                                         $_ = $filename;
 966                                                         s/^\d+-([^-]+)-//;
 967                                                         s/_/ /g;
 968                                                         s/\b(\w)/\U\1/g;
 969                                                 }
 970                                                 $track{"$dirname/$filename"} = $_;
 971                                                 #print STDERR "{$dirname/$filename} = $_\n";
 972                                                 #print qq~\$track{"$dirname/$filename"} = $_;\n~ if /magic/i;
 973                                                 $album{"$dirname/$filename"} = $album;
 974                                                 #print STDERR "$dirname/$filename $album\n";
 975                                         }
 976                                         last unless /\S/;
 977                                 }
 978                         }
 979                 }
 980                 close ALB;
 981         }
 982 };
 983
 984 sub extract_artist_title($\%) {
 985         my ($file, $info) = @_;
 986         my ($a, $t, $tr, $alb);
 987         local *F;
 988
 989         $info->{info_origin} = "filename";
 990
 991         # cut path
 992         $file =~ s|(.*)/||;
 993         my $p = $1;
 994
 995         # cut extension
 996         $file =~ s/(.*)\..*/\1/;
 997
 998         if(-e "$p/.andre" || ($file !~ /-/ && $file =~ /\..*\./)) {
 999                 # andre-notatie
1000                 $file =~ s/_ddd\.hq//;
1001                 $file =~ s/_/-/g;
1002                 $file =~ s/\./_/g;
1003                 $info->{info_origin} = "filename[andre]";
1004         }
1005
1006         my $pp = $p;
1007         $pp = '' if -e "$p/.noalbum";
1008         if(open F, "$p/.album") {
1009                 $alb = <F>;
1010                 close F;
1011                 chomp $alb;
1012         }
1013         $file =~ s/\s*$//;
1014         if($file =~ s/^\s*(\d\d)(\D)/\2/i ||            # nummer weg, 2 digits
1015                 $file =~ s/^\s*(\d{0,3})[^a-z0-9]+//i)  # nummer weg, 1-3 digits met separator
1016         {
1017                 $tr = $1;
1018         }
1019         $file =~ s/^[^a-z]+//i;
1020
1021         $pp =~ s|/+$||;
1022         $pp =~ s|.*/||;
1023
1024         if($file =~ /[\x80-\xff]{2,}/) {
1025                 my $dfile;
1026                 eval { $dfile = decode_utf8($file, Encode::FB_CROAK); };
1027                 if(!$@) {
1028                         $file = encode("iso-8859-1", $dfile);
1029                         $info->{info_origin} .= "(utf8)";
1030                 }
1031         }
1032
1033         if($file =~ /[_\s]*-[_\s]*/) {
1034                 ($a, $t) = ($`, $');
1035                 if($pp) { ($alb = $pp) =~ s/.*-[_\s]*//; }
1036         } else {
1037                 if(!$alb && $pp =~ s/-[_\s]*(.*)//) { $alb = $1; }
1038                 ($a, $t) = ($pp, $file);
1039         }
1040         if(-e "$p/.reverse") { ($a, $t) = ($t, $a); }
1041
1042         $info->{artist} = cleanup_name($a);
1043         $info->{title} = cleanup_name($t);
1044         $info->{album} = cleanup_name($alb);
1045         $info->{track} = $tr;
1046
1047         return 1;
1048 }
1049
1050 sub is_nfs($) {
1051         my ($file) = @_;
1052
1053         # major device number must be 0
1054         my $maj = (stat $file)[0] >> 8;
1055         return $maj == 0;
1056 }