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_C, $opt_L, $opt_M, $opt_R, $opt_T, $opt_c, $opt_d, $opt_e, $opt_f, $opt_h, $opt_l, $opt_m, $opt_n, $opt_p, $opt_q, $opt_r, $opt_v);
  47
  48 sub get_wav_params($\%;$);
  49 sub getinfo_mp3($\%);
  50 sub getinfo_ogg($\%);
  51 sub getinfo_mid($\%);
  52 sub getinfo_wav($\%);
  53 sub getinfo_flac($\%);
  54 sub getinfo_shorten($\%);
  55 sub getinfo_musepack($\%);
  56 sub getinfo_raw($\%);
  57 sub getinfo_mplayer($\%);
  58 sub getinfo_ac3($\%);
  59 sub getinfo_soepkip($\%);
  60 sub read_eric_files();
  61 sub extract_artist_title($\%);
  62 sub is_nfs($);
  63
  64 $opt_R = 10000;
  65 if(open F, ".soepkiptng_random_pref") {
  66         $opt_R = 0 + <F>;
  67         close F;
  68 }
  69 getopts('Cfredqvhc:LM:R:Tpmln');
  70 my $force = 1 if $opt_f;
  71 $| = 1;
  72 my $do_delete = !$opt_d && !$opt_r;
  73 if($opt_p && scalar @ARGV == 0) { push @ARGV, "."; }
  74 $opt_n = " (not)" if $opt_n;
  75
  76 $opt_h and die <<EOF;
  77 usage: soepkiptng_update [-defhqrvCL] [-c configfile] [-R pref] [dir...]
  78
  79 options:
  80   -C            : don't fix artist/title/album upper/lowercase
  81   -c configfile : override soepkiptng config file
  82   -d            : turn on debugging
  83   -e            : don't read "ericfiles"
  84   -f            : force updating of info even if song is already in database
  85   -h            : get this help
  86   -L            : set last_played to current time
  87   -m            : skip recent files
  88   -M n          : add max N files
  89   -n            : don't actually do anything to the database
  90   -q            : be quiet
  91   -r            : don't recurse subdirectories
  92   -R pref       : set random_pref field
  93   -T            : test file integrity before adding
  94   -v            : be verbose
  95
  96 Directories containing the file ".nosoepkiptng" will be skipped.
  97 EOF
  98
  99 my %conf;
 100 read_configfile(\%conf, $opt_c);
 101
 102
 103 # for the web interface (stupid browsers/users)
 104 $SIG{'PIPE'} = 'IGNORE';
 105
 106 # disable warnings (to make MP3::Tag shut up)
 107 if($opt_q) {
 108         $SIG{__WARN__} = sub { };
 109 }
 110
 111 my $dbh = DBI->connect("DBI:$conf{'db_type'}:$conf{'db_name'}:$conf{'db_host'}", $conf{'db_user'}, $conf{'db_pass'})
 112         or die "can't connect to database";
 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                 if(open(F, "-|") == 0) {
 634                         open STDERR, ">&STDOUT";
 635                         exec "flac", "-st", $file;
 636                         die "flac: $!\n";
 637                 }
 638                 my $last;
 639                 while(<F>) {
 640                         next if $_ eq $last;
 641                         $output .= $_;
 642                         $last = $_;
 643                 }
 644                 close F;
 645                 if($?) {
 646                         if($output =~ /^(.*error.*)$/im) {
 647                                 warn "$file: integrity test failed, ignoring ($1)\n";
 648                         } else {
 649                                 print STDERR $output;
 650                                 warn "$file: integrity test failed, ignoring\n";
 651                         }
 652                         return $info->{skip} = 1;
 653                 }
 654         }
 655
 656         if(open(F, "-|") == 0) {
 657                 open STDERR, ">/dev/null";
 658                 exec qw/metaflac
 659                         --show-sample-rate
 660                         --show-channels
 661                         --show-total-samples
 662                         --show-bps
 663                         --show-tag=artist
 664                         --show-tag=title
 665                         --show-tag=tracknumber
 666                         --show-tag=album
 667                         /, $file;
 668                 die;
 669         }
 670         my ($totsamp, @rest, @a);
 671         ($info->{freq}, $info->{chan}, $totsamp, $info->{bps}, @rest) = <F>;
 672         close F;
 673         foreach(@rest) {
 674                 if(s/^title=(.*\S)//i) { $info->{title} = $1; }
 675                 elsif(s/^tracknumber=(.*\S)//i) { $info->{track} = $1; }
 676                 elsif(s/^album=(.*\S)//i) { $info->{album} = $1; }
 677                 elsif(s/^artist=(.*\S)//i) { push @a, $1; }
 678         }
 679         $info->{artist} = join " & ", @a;
 680
 681         my $totbytes = $totsamp * $info->{chan} * $info->{bps} / 8;
 682         $info->{encoding} = "flac" . ($totbytes? sprintf(" (%d%%)", 100 * $filesize / $totbytes) : "");
 683         $info->{len} = $info->{freq}? $totsamp / $info->{freq} : 0;
 684         $info->{info_origin} = "flac" if $info->{artist} && $info->{title};
 685         check_gap_flac($file, $info->{chan} * $info->{bps});
 686         return 1;
 687 }
 688
 689 sub getinfo_shorten($\%) {
 690         my ($file, $info) = @_;
 691
 692         $file =~ /\.shn$/i
 693                 or return undef;
 694
 695         $info->{encoding} = "Shorten";
 696         $info->{len} = 0;
 697         $info->{freq} = 44100;
 698         $info->{chan} = 2;
 699         return 1;
 700 }
 701
 702 # handles only SV7
 703 sub getinfo_musepack($\%) {
 704         my ($file, $info) = @_;
 705         my ($buf, $id3);
 706         local *F;
 707
 708         $file =~ /\.mp[cp+]$/i
 709                 or return undef;
 710         open F, $file or do {
 711                 warn "$file: $!\n";
 712                 return undef;
 713         };
 714         read F, $buf, 12;
 715         seek F, -128, 2;
 716         read F, $id3, 128;
 717         close F;
 718         $buf =~ /^MP\+/ or return undef;
 719         my ($version, $frames, $flags) = unpack "VVV", $buf;
 720         $version >>= 24;
 721         if($version != 7) {
 722                 warn "$_: unknown version: SV$version\n";
 723                 return undef;
 724         }
 725         $info->{encoding} = "Musepack";
 726         $info->{freq} = (44100, 48000, 37800, 32000)[($flags >> 16) & 3];
 727         $info->{len} = $frames * 1152 / $info->{freq};
 728         push @{$info->{encoding_extra}}, sprintf "%dkb/s", (8 * (-s $file) / $info->{len} + 500) / 1000;
 729         $info->{chan} = 2;
 730
 731         get_ape($file, %$info, 0) ||      # APE tag at beginning
 732         get_ape($file, %$info, -32) ||    # APE tag at end
 733         get_ape($file, %$info, -160) ||   # APE tag at end followed by ID3 tag
 734         get_id3($file, %$info);
 735         return 1;
 736 }
 737
 738 sub getinfo_raw($\%) {
 739         my ($file, $info) = @_;
 740
 741         $file =~ /\.raw$/i
 742                 or return undef;
 743
 744         $info->{encoding} = "raw";
 745         $info->{len} = (-s $file) / 176400;
 746         $info->{freq} = 44100;
 747         $info->{chan} = 2;
 748         return 1;
 749 }
 750
 751 sub getinfo_mplayer($\%) {
 752         my ($file, $info) = @_;
 753         local $_;
 754         my %prop;
 755
 756         $file =~ /\.(mpe?g|avi|asx|asf|vob|wmv|ra?m|ra|mov|m2v|wma|aac|m4a|m4b|mp4|flv|ape|aiff)$/i
 757                 or return undef;
 758
 759         local *F;
 760         if(open(F, "-|") == 0) {
 761                 open STDIN, "/dev/null";
 762                 open STDERR, ">&STDOUT";
 763                 delete $ENV{DISPLAY};
 764                 exec qw"mplayer -identify -vo null -ao null -frames 0", $file;
 765                 die "mplayer";
 766         }
 767         while(<F>) {
 768                 s/\s+$//;
 769                 /^\s+author:\s*(.*)/i       and $info->{artist} = $1;
 770                 /^\s+(name|title):\s*(.*)/i and $info->{title} = $2;
 771                 /^\s+album:\s*(.*)/i        and $info->{album} = $1;
 772                 /^\s+track:\s*(\d+)/i       and $info->{track} = $1;
 773                 /^ID_(\w+)=(.*)/ and $prop{lc($1)} = $2;
 774         }
 775         close F;
 776         if($file =~ /\.(ra?m|ra)$/i) {
 777                 $info->{encoding} = $prop{video_format}? "RealVideo":"RealAudio";
 778         } else {
 779                 $info->{encoding} = ($prop{video_format}? "Video: ":"") . $1;
 780         }
 781         $info->{info_origin} = "Clip Info" if $info->{artist} || $info->{title};
 782         if($prop{video_width} && $prop{video_height}) {
 783                 $info->{encoding} .= " ($prop{video_width}x$prop{video_height})";
 784         }
 785         if($prop{video_format}) {
 786                 push @{$info->{encoding_extra}}, sprintf("%s+%skb/s",
 787                         $prop{video_bitrate}? int(($prop{video_bitrate} + 500) / 1000) : "?",
 788                         $prop{audio_bitrate}? int(($prop{audio_bitrate} + 500) / 1000) : "?");
 789                 $info->{freq} = 0;
 790                 $info->{chan} = 0;
 791         } else {
 792                 # audio only
 793                 if($prop{audio_format} >= 0x160 && $prop{audio_format} <= 0x163) {
 794                         my $wma = $prop{audio_format} - 0x160 + 1;
 795                         $wma = 3 if $wma == 4;
 796                         $info->{encoding} = "WMA$wma";
 797                 } elsif($prop{audio_format} eq "mp4a") {
 798                         $info->{encoding} = "AAC";
 799                 } elsif($prop{audio_format} eq "twos" && $file =~ /\.aiff$/i) {
 800                         $info->{encoding} = "AIFF";
 801                         delete $prop{audio_bitrate};
 802                 } elsif($prop{audio_format} eq "alac" || $prop{audio_format} eq "APE") {
 803                         $info->{encoding} = uc $prop{audio_format};
 804                         my $uncompbytes = $prop{length} * $prop{audio_rate} * $prop{audio_nch} * 2;
 805                         if($uncompbytes) {
 806                                 $info->{encoding} .= sprintf " (%d%%)", 100 * (-s $file) / $uncompbytes;
 807                         }
 808                 }
 809                 push @{$info->{encoding_extra}}, sprintf("%dkb/s", ($prop{audio_bitrate} + 500) / 1000)
 810                         if $prop{audio_bitrate};
 811                 $info->{freq} = $prop{audio_freq};
 812                 $info->{chan} = $prop{audio_nch};
 813         }
 814         if(exists $info->{encoding_extra} && @{$info->{encoding_extra}} == 1 && ${$info->{encoding_extra}}[0] =~ m|115\d\+224kb/s|) {
 815                 if($info->{encoding} =~ s/mpg \(352x288\)/VCD (PAL)/ ||
 816                    $info->{encoding} =~ s/mpg \(352x240\)/VCD (NTSC)/) {
 817                         delete $info->{encoding_extra};
 818                 }
 819         }
 820         $info->{len} = $prop{length};
 821         return 1;
 822 }
 823
 824 sub getinfo_ac3($\%) {
 825         my ($file, $info) = @_;
 826
 827         $file =~ /\.(ac3)$/i
 828                 or return undef;
 829
 830         $info->{encoding} = "AC3";
 831         $info->{freq} = 0;
 832         $info->{chan} = 0;
 833         $info->{len} = 0;
 834         return 1;
 835 }
 836
 837 sub getinfo_soepkip($\%) {
 838         my ($file, $info) = @_;
 839         local *F;
 840
 841         $file =~ s|(.*)/+||;
 842         my $dir = $1;
 843
 844         open F, "$dir/.soepkiptng_info" or return undef;
 845         local $_;
 846         FILE: while(<F>) {
 847                 if(/^\[(.+)\]/ && $1 eq $file) {
 848                         $info->{info_origin} = ".soepkiptng_info";
 849                         while(<F>) {
 850                                 last FILE if /^\[/;
 851                                 s/\s+$//;
 852                                 /^(artist|album|track|title)\s*=\s*(.*)/
 853                                         and $info->{$1} = $2;
 854                         }
 855                         close F;
 856                         return 1;
 857                 }
 858         }
 859         close F;
 860         return undef;
 861 }
 862
 863 # returns samplefreq, channels, seconds
 864 sub get_wav_params($\%;$) {
 865         my ($file, $info, $offset) = @_;
 866         $offset = 0 + $offset;
 867         local *F;
 868         my $buf;
 869
 870         open F, $file or return undef;
 871         FILE: for(;;) {
 872                 if($offset) { read(F, $buf, $offset) or last; }
 873                 read(F, $buf, 12)  or last;
 874                 my ($riff, $len, $wave) = unpack("a4Va4", $buf);
 875                 last if $riff ne 'RIFF' || $wave ne 'WAVE';
 876
 877                 # find 'fmt ' chunk
 878                 my ($type, $len);
 879                 for(;;) {
 880                         read(F, $buf, 8) or last FILE;
 881                         ($type, $len) = unpack("a4V", $buf);
 882                         last if $type eq 'fmt ';
 883                         my $i = 0;
 884                         while($i < $len) {
 885                                 my $r = $len < 4096? $len : 4096;
 886                                 $r = read F, $buf, $r or last FILE;
 887                                 $i += $r;
 888                         }
 889                 }
 890                 read(F, $buf, $len)  or last;
 891                 my ($fmt, $chan, $freq, $bytespersec, $align, $bitspersample, $cbsize, $validbitspersample, undef, $subfmt, $subguid) =
 892                         unpack("vvVVvvvvVva14", $buf);
 893                 #print STDERR "fmt=$fmt ch=$chan f=$freq byps=$bytespersec al=$align bps=$bitspersample cb=$cbsize sfmt=$subfmt\n";
 894                 if($len >= 18 && $fmt == 0xfffe && $cbsize == 22 && $subguid eq "\x00\x00\x00\x00\x10\x00\x80\x00\x00\xAA\x00\x38\x9B\x71") {
 895                         $bitspersample = $validbitspersample;
 896                         $fmt = $subfmt;
 897                 }
 898                 my $encoding = "WAV";
 899                 if($fmt == 3)    { $encoding .= " (float)"; }
 900                 elsif($fmt == 6) { $encoding .= " (A-law)"; }
 901                 elsif($fmt == 7) { $encoding .= " (µ-law)"; }
 902                 elsif($fmt != 1) { $encoding .= sprintf " (fmt %d)", $fmt; }
 903
 904                 # find 'data' chunk
 905                 for(;;) {
 906                         read(F, $buf, 8) or last FILE;
 907                         ($type, $len) = unpack("a4V", $buf);
 908                         last if $type eq 'data';
 909                         while($len) {
 910                                 my $r = $len < 4096? $len : 4096;
 911                                 $r = read F, $buf, $r or last FILE;
 912                                 $len -= $r;
 913                         }
 914                 }
 915                 close F;
 916                 $info->{len} = int($len / $bytespersec + 0.5);
 917                 $info->{freq} = $freq;
 918                 $info->{chan} = $chan;
 919                 $info->{bps} = $bitspersample;
 920                 $info->{encoding} = $encoding;
 921                 return 1;
 922         }
 923         close F;
 924         return undef;
 925 }
 926
 927 sub read_eric_files() {
 928         foreach my $file (split /\s+/, $conf{'description_files'}) {
 929                 my ($artist, $album, $dirname);
 930                 open ALB, $file or die "$file: $!\n";
 931                 while(<ALB>) {
 932                         /\S/ or do { $artist = $album = $dirname = ""; next; };
 933                         /^artist\s*(.*?)\s*$/ and do { $artist = $1; next; };
 934                         /^title\s*(.*?)\s*$/ and do { $album = $1; next; };
 935                         if(/^dirname\s+(.*\S)/) {
 936                                 my $realartist;
 937
 938                                 $dirname = $1;
 939                                 (my $artist_s = $dirname) =~ s/-.*//;
 940                                 while(<ALB>) {
 941                                         /^##\s*(.*\S)/ and do {
 942                                                 $realartist = $1;
 943                                                 next;
 944                                         };
 945                                         if(s/^track\s+(\S+)\.\w+\s*//) {
 946                                                 my $a = $1;
 947                                                 my $filename = $1;
 948                                                 $a =~ s/^(\d+)-([^-]+)-.*/\2/;
 949                                                 $tracknr{"$dirname/$filename"} = $1;
 950                                                 #print STDERR "a=$a artist_s=$artist_s artist=$artist realartist=$realartist\n";
 951                                                 if($realartist) {
 952                                                         $artist{"$dirname/$filename"} = $realartist;
 953                                                         $realartist = undef;
 954                                                 } elsif($a eq $artist_s) {
 955                                                         $artist{"$dirname/$filename"} = $artist;
 956                                                 } else {
 957                                                         $a =~ s/_/ /g;
 958                                                         $a =~ s/\b(\w)/\U\1/g;
 959                                                         $artist{"$dirname/$filename"} = $a;
 960                                                 }
 961                                                 s/\s*$//;
 962                                                 if(!$_) {
 963                                                         $_ = $filename;
 964                                                         s/^\d+-([^-]+)-//;
 965                                                         s/_/ /g;
 966                                                         s/\b(\w)/\U\1/g;
 967                                                 }
 968                                                 $track{"$dirname/$filename"} = $_;
 969                                                 #print STDERR "{$dirname/$filename} = $_\n";
 970                                                 #print qq~\$track{"$dirname/$filename"} = $_;\n~ if /magic/i;
 971                                                 $album{"$dirname/$filename"} = $album;
 972                                                 #print STDERR "$dirname/$filename $album\n";
 973                                         }
 974                                         last unless /\S/;
 975                                 }
 976                         }
 977                 }
 978                 close ALB;
 979         }
 980 };
 981
 982 sub extract_artist_title($\%) {
 983         my ($file, $info) = @_;
 984         my ($a, $t, $tr, $alb);
 985         local *F;
 986
 987         $info->{info_origin} = "filename";
 988
 989         # cut path
 990         $file =~ s|(.*)/||;
 991         my $p = $1;
 992
 993         # cut extension
 994         $file =~ s/(.*)\..*/\1/;
 995
 996         if(-e "$p/.andre" || ($file !~ /-/ && $file =~ /\..*\./)) {
 997                 # andre-notatie
 998                 $file =~ s/_ddd\.hq//;
 999                 $file =~ s/_/-/g;
1000                 $file =~ s/\./_/g;
1001                 $info->{info_origin} = "filename[andre]";
1002         }
1003
1004         my $pp = $p;
1005         $pp = '' if -e "$p/.noalbum";
1006         if(open F, "$p/.album") {
1007                 $alb = <F>;
1008                 close F;
1009                 chomp $alb;
1010         }
1011         $file =~ s/\s*$//;
1012         if($file =~ s/^\s*(\d\d)(\D)/\2/i ||            # nummer weg, 2 digits
1013                 $file =~ s/^\s*(\d{0,3})[^a-z0-9]+//i)  # nummer weg, 1-3 digits met separator
1014         {
1015                 $tr = $1;
1016         }
1017         $file =~ s/^[^a-z]+//i;
1018
1019         $pp =~ s|/+$||;
1020         $pp =~ s|.*/||;
1021
1022         if($file =~ /[\x80-\xff]{2,}/) {
1023                 my $dfile;
1024                 eval { $dfile = decode_utf8($file, Encode::FB_CROAK); };
1025                 if(!$@) {
1026                         $file = encode("iso-8859-1", $dfile);
1027                         $info->{info_origin} .= "(utf8)";
1028                 }
1029         }
1030
1031         if($file =~ /[_\s]*-[_\s]*/) {
1032                 ($a, $t) = ($`, $');
1033                 if($pp) { ($alb = $pp) =~ s/.*-[_\s]*//; }
1034         } else {
1035                 if(!$alb && $pp =~ s/-[_\s]*(.*)//) { $alb = $1; }
1036                 ($a, $t) = ($pp, $file);
1037         }
1038         if(-e "$p/.reverse") { ($a, $t) = ($t, $a); }
1039
1040         $info->{artist} = cleanup_name($a);
1041         $info->{title} = cleanup_name($t);
1042         $info->{album} = cleanup_name($alb);
1043         $info->{track} = $tr;
1044
1045         return 1;
1046 }
1047
1048 sub is_nfs($) {
1049         my ($file) = @_;
1050
1051         # major device number must be 0
1052         my $maj = (stat $file)[0] >> 8;
1053         return $maj == 0;
1054 }