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