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