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         print "$file\n" if $opt_v;
 171
 172         if(length($file) > 255) {
 173                 print STDERR "Skipping $file, filename >255 chars.\n" unless $opt_q;
 174                 next;
 175         }
 176
 177 #       if(++$num % 10 == 0) { print STDERR "."; }
 178
 179         # get file encoding; skip if unknown
 180         my %info;
 181         $/ = "\n";
 182         getinfo_mp3($file, %info) ||
 183         getinfo_ogg($file, %info) ||
 184         getinfo_mid($file, %info) ||
 185         getinfo_wav($file, %info) ||
 186         getinfo_flac($file, %info) ||
 187         getinfo_shorten($file, %info) ||
 188         getinfo_musepack($file, %info) ||
 189         getinfo_mplayer($file, %info) ||
 190         getinfo_ac3($file, %info) ||
 191         getinfo_raw($file, %info);
 192
 193         getinfo_soepkip($file, %info);
 194
 195         $/ = "\0";
 196
 197         $info{len} = 0 + $info{len};
 198         $info{encoding} or do {
 199                 print STDERR "Filetype of $file unknown\n" unless $opt_q;
 200                 next;
 201         };
 202         if($info{freq} && ($info{freq} < 44090 || $info{freq} > 44110)) {
 203                 my $s = sprintf "%f", $info{freq} / 1000;
 204                 $s =~ s/\.?0+$//;
 205                 push @{$info{encoding_extra}}, "${s}kHz";
 206         }
 207         if($info{bps} && ($info{bps} != 16)) {
 208                 push @{$info{encoding_extra}}, sprintf "%dbit", $info{bps};
 209         }
 210         if($info{chan} == 1) {
 211                 push @{$info{encoding_extra}}, "mono";
 212         }
 213         if(exists $info{encoding_extra} && @{$info{encoding_extra}}) {
 214                 $info{encoding} .= sprintf " (%s)", join(", ", @{$info{encoding_extra}});
 215         }
 216
 217         # check "nolocal" setting (only files on NFS are allowed)
 218         if($conf{nolocal} && !is_nfs($file)) {
 219                 die "Error: file on local filesystem: $file\n";
 220         }
 221
 222         # skip if already in database (unless "force" was given)
 223         if($filename{$file}) {
 224                 if($force) {
 225                         print "Updating $file:\n";
 226                         $num_updated++;
 227                 } else {
 228                         $num_skipped++;
 229                         delete $filename{$file};
 230                         next;
 231                 }
 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         $info->{encoding} = "WAV";
 581         return 1;
 582 }
 583
 584 sub getinfo_mid($\%) {
 585         my ($file, $info) = @_;
 586
 587         $file =~ /\.(mid|rcp|r36|g18|g36|mod)$/i
 588                 or return undef;
 589
 590         $info->{encoding} = "Midi";
 591         return 1;
 592 }
 593
 594 sub getinfo_flac($\%) {
 595         my ($file, $info) = @_;
 596
 597         $file =~ /\.flac$/i
 598                 or return undef;
 599
 600         my $filesize = -s $file or return undef;
 601
 602         if($opt_T) {
 603                 system "flac", "-t", $file;
 604                 if($?) {
 605                         warn "$file: integrity test failed, ignoring\n";
 606                         return undef;
 607                 }
 608         }
 609
 610         if(open(F, "-|") == 0) {
 611                 open STDERR, ">/dev/null";
 612                 exec qw/metaflac
 613                         --show-sample-rate
 614                         --show-channels
 615                         --show-total-samples
 616                         --show-bps
 617                         --show-tag=artist
 618                         --show-tag=title
 619                         --show-tag=tracknumber
 620                         --show-tag=album
 621                         /, $file;
 622                 die;
 623         }
 624         my ($totsamp, @rest, @a);
 625         ($info->{freq}, $info->{chan}, $totsamp, $info->{bps}, @rest) = <F>;
 626         foreach(@rest) {
 627                 if(s/^title=(.*\S)//i) { $info->{title} = $1; }
 628                 elsif(s/^tracknumber=(.*\S)//i) { $info->{track} = $1; }
 629                 elsif(s/^album=(.*\S)//i) { $info->{album} = $1; }
 630                 elsif(s/^artist=(.*\S)//i) { push @a, $1; }
 631         }
 632         $info->{artist} = join " & ", @a;
 633
 634         my $totbytes = $totsamp * $info->{chan} * $info->{bps} / 8;
 635         $info->{encoding} = "flac" . ($totbytes? sprintf(" (%d%%)", 100 * $filesize / $totbytes) : "");
 636         $info->{len} = $info->{freq}? $totsamp / $info->{freq} : 0;
 637         $info->{info_origin} = "flac" if $info->{artist} && $info->{title};
 638         return 1;
 639 }
 640
 641 sub getinfo_shorten($\%) {
 642         my ($file, $info) = @_;
 643
 644         $file =~ /\.shn$/i
 645                 or return undef;
 646
 647         $info->{encoding} = "Shorten";
 648         $info->{len} = 0;
 649         $info->{freq} = 44100;
 650         $info->{chan} = 2;
 651         return 1;
 652 }
 653
 654 # handles only SV7
 655 sub getinfo_musepack($\%) {
 656         my ($file, $info) = @_;
 657         my ($buf, $id3);
 658         local *F;
 659
 660         $file =~ /\.mp[cp+]$/i
 661                 or return undef;
 662         open F, $file or do {
 663                 warn "$file: $!\n";
 664                 return undef;
 665         };
 666         read F, $buf, 12;
 667         seek F, -128, 2;
 668         read F, $id3, 128;
 669         close F;
 670         $buf =~ /^MP\+/ or return undef;
 671         my ($version, $frames, $flags) = unpack "VVV", $buf;
 672         $version >>= 24;
 673         if($version != 7) {
 674                 warn "$_: unknown version: SV$version\n";
 675                 return undef;
 676         }
 677         $info->{encoding} = "Musepack";
 678         $info->{freq} = (44100, 48000, 37800, 32000)[($flags >> 16) & 3];
 679         $info->{len} = $frames * 1152 / $info->{freq};
 680         push @{$info->{encoding_extra}}, sprintf "%dkb/s", (8 * (-s $file) / $info->{len} + 500) / 1000;
 681         $info->{chan} = 2;
 682
 683         get_ape($file, %$info, 0) ||      # APE tag at beginning
 684         get_ape($file, %$info, -32) ||    # APE tag at end
 685         get_ape($file, %$info, -160) ||   # APE tag at end followed by ID3 tag
 686         get_id3($file, %$info);
 687         return 1;
 688 }
 689
 690 sub getinfo_raw($\%) {
 691         my ($file, $info) = @_;
 692
 693         $file =~ /\.raw$/i
 694                 or return undef;
 695
 696         $info->{encoding} = "raw";
 697         $info->{len} = (-s $file) / 176400;
 698         $info->{freq} = 44100;
 699         $info->{chan} = 2;
 700         return 1;
 701 }
 702
 703 sub getinfo_mplayer($\%) {
 704         my ($file, $info) = @_;
 705         local $_;
 706         my %prop;
 707
 708         $file =~ /\.(mpe?g|avi|asx|asf|vob|wmv|ra?m|ra|mov|m2v|wma|aac|m4a|m4b|mp4|flv|ape)$/i
 709                 or return undef;
 710
 711         local *F;
 712         if(open(F, "-|") == 0) {
 713                 open STDIN, "/dev/null";
 714                 open STDERR, ">&STDOUT";
 715                 delete $ENV{DISPLAY};
 716                 exec qw"mplayer -identify -vo null -ao null -frames 0", $file;
 717                 die "mplayer";
 718         }
 719         while(<F>) {
 720                 s/\s+$//;
 721                 /^\s+author:\s*(.*)/i       and $info->{artist} = $1;
 722                 /^\s+(name|title):\s*(.*)/i and $info->{title} = $2;
 723                 /^\s+album:\s*(.*)/i        and $info->{album} = $1;
 724                 /^\s+track:\s*(\d+)/i       and $info->{track} = $1;
 725                 /^ID_(\w+)=(.*)/ and $prop{lc($1)} = $2;
 726         }
 727         close F;
 728         if($file =~ /\.(ra?m|ra)$/i) {
 729                 $info->{encoding} = $prop{video_format}? "RealVideo":"RealAudio";
 730         } else {
 731                 $info->{encoding} = ($prop{video_format}? "Video: ":"") . $1;
 732         }
 733         $info->{info_origin} = "Clip Info" if $info->{artist} || $info->{title};
 734         if($prop{video_width} && $prop{video_height}) {
 735                 $info->{encoding} .= " ($prop{video_width}x$prop{video_height})";
 736         }
 737         if($prop{video_format}) {
 738                 push @{$info->{encoding_extra}}, sprintf("%s+%skb/s",
 739                         $prop{video_bitrate}? int(($prop{video_bitrate} + 500) / 1000) : "?",
 740                         $prop{audio_bitrate}? int(($prop{audio_bitrate} + 500) / 1000) : "?");
 741                 $info->{freq} = 0;
 742                 $info->{chan} = 0;
 743         } else {
 744                 # audio only
 745                 if($prop{audio_format} >= 0x160 && $prop{audio_format} <= 0x163) {
 746                         my $wma = $prop{audio_format} - 0x160 + 1;
 747                         $wma = 3 if $wma == 4;
 748                         $info->{encoding} = "WMA$wma";
 749                 } elsif($prop{audio_format} eq "mp4a") {
 750                         $info->{encoding} = "AAC";
 751                 } elsif($prop{audio_format} eq "alac" || $prop{audio_format} eq "APE") {
 752                         $info->{encoding} = uc $prop{audio_format};
 753                         my $uncompbytes = $prop{length} * $prop{audio_rate} * $prop{audio_nch} * 2;
 754                         if($uncompbytes) {
 755                                 $info->{encoding} .= sprintf " (%d%%)", 100 * (-s $file) / $uncompbytes;
 756                         }
 757                 }
 758                 push @{$info->{encoding_extra}}, sprintf("%dkb/s", ($prop{audio_bitrate} + 500) / 1000)
 759                         if $prop{audio_bitrate};
 760                 $info->{freq} = $prop{audio_freq};
 761                 $info->{chan} = $prop{audio_nch};
 762         }
 763         if(exists $info->{encoding_extra} && @{$info->{encoding_extra}} == 1 && ${$info->{encoding_extra}}[0] =~ m|115\d\+224kb/s|) {
 764                 if($info->{encoding} =~ s/mpg \(352x288\)/VCD (PAL)/ ||
 765                    $info->{encoding} =~ s/mpg \(352x240\)/VCD (NTSC)/) {
 766                         delete $info->{encoding_extra};
 767                 }
 768         }
 769         $info->{len} = $prop{length};
 770         return 1;
 771 }
 772
 773 sub getinfo_ac3($\%) {
 774         my ($file, $info) = @_;
 775
 776         $file =~ /\.(ac3)$/i
 777                 or return undef;
 778
 779         $info->{encoding} = "AC3";
 780         $info->{freq} = 0;
 781         $info->{chan} = 0;
 782         $info->{len} = 0;
 783         return 1;
 784 }
 785
 786 sub getinfo_soepkip($\%) {
 787         my ($file, $info) = @_;
 788         local *F;
 789
 790         $file =~ s|(.*)/+||;
 791         my $dir = $1;
 792
 793         open F, "$dir/.soepkiptng_info" or return undef;
 794         local $_;
 795         FILE: while(<F>) {
 796                 if(/^\[(.+)\]/ && $1 eq $file) {
 797                         $info->{info_origin} = ".soepkiptng_info";
 798                         while(<F>) {
 799                                 last FILE if /^\[/;
 800                                 s/\s+$//;
 801                                 /^(artist|album|track|title)\s*=\s*(.*)/
 802                                         and $info->{$1} = $2;
 803                         }
 804                         close F;
 805                         return 1;
 806                 }
 807         }
 808         close F;
 809         return undef;
 810 }
 811
 812 # returns samplefreq, channels, seconds
 813 sub get_wav_params($\%;$) {
 814         my ($file, $info, $offset) = @_;
 815         $offset = 0 + $offset;
 816         local *F;
 817         my $buf;
 818
 819         open F, $file or return undef;
 820         FILE: for(;;) {
 821                 if($offset) { read(F, $buf, $offset) or last; }
 822                 read(F, $buf, 12)  or last;
 823                 my ($riff, $len, $wave) = unpack("a4Va4", $buf);
 824                 last if $riff ne 'RIFF' || $wave ne 'WAVE';
 825
 826                 # find 'fmt ' chunk
 827                 my ($type, $len);
 828                 for(;;) {
 829                         read(F, $buf, 8) or last FILE;
 830                         ($type, $len) = unpack("a4V", $buf);
 831                         last if $type eq 'fmt ';
 832                         my $i = 0;
 833                         while($i < $len) {
 834                                 my $r = $len < 4096? $len : 4096;
 835                                 $r = read F, $buf, $r or last FILE;
 836                                 $i += $r;
 837                         }
 838                 }
 839                 read(F, $buf, $len)  or last;
 840                 my ($fmt, $chan, $freq, $bytespersec, $align, $bitspersample) =
 841                         unpack("vvVVvv", $buf);
 842 #print STDERR "         my ($fmt, $chan, $freq, $bytespersec, $align, $bitspersample) =\n";
 843                 last if $fmt != 1;
 844
 845                 # find 'data' chunk
 846                 for(;;) {
 847                         read(F, $buf, 8) or last FILE;
 848                         ($type, $len) = unpack("a4V", $buf);
 849                         last if $type eq 'data';
 850                         while($len) {
 851                                 my $r = $len < 4096? $len : 4096;
 852                                 $r = read F, $buf, $r or last FILE;
 853                                 $len -= $r;
 854                         }
 855                 }
 856                 close F;
 857                 $info->{len} = int($len / $bytespersec + 0.5);
 858                 $info->{freq} = $freq;
 859                 $info->{chan} = $chan;
 860                 return 1;
 861         }
 862         close F;
 863         return undef;
 864 }
 865
 866 sub read_eric_files() {
 867         foreach my $file (split /\s+/, $conf{'description_files'}) {
 868                 my ($artist, $album, $dirname);
 869                 open ALB, $file or die "$file: $!\n";
 870                 while(<ALB>) {
 871                         /\S/ or do { $artist = $album = $dirname = ""; next; };
 872                         /^artist\s*(.*?)\s*$/ and do { $artist = $1; next; };
 873                         /^title\s*(.*?)\s*$/ and do { $album = $1; next; };
 874                         if(/^dirname\s+(.*\S)/) {
 875                                 my $realartist;
 876
 877                                 $dirname = $1;
 878                                 (my $artist_s = $dirname) =~ s/-.*//;
 879                                 while(<ALB>) {
 880                                         /^##\s*(.*\S)/ and do {
 881                                                 $realartist = $1;
 882                                                 next;
 883                                         };
 884                                         if(s/^track\s+(\S+)\.\w+\s*//) {
 885                                                 my $a = $1;
 886                                                 my $filename = $1;
 887                                                 $a =~ s/^(\d+)-([^-]+)-.*/\2/;
 888                                                 $tracknr{"$dirname/$filename"} = $1;
 889                                                 #print STDERR "a=$a artist_s=$artist_s artist=$artist realartist=$realartist\n";
 890                                                 if($realartist) {
 891                                                         $artist{"$dirname/$filename"} = $realartist;
 892                                                         $realartist = undef;
 893                                                 } elsif($a eq $artist_s) {
 894                                                         $artist{"$dirname/$filename"} = $artist;
 895                                                 } else {
 896                                                         $a =~ s/_/ /g;
 897                                                         $a =~ s/\b(\w)/\U\1/g;
 898                                                         $artist{"$dirname/$filename"} = $a;
 899                                                 }
 900                                                 s/\s*$//;
 901                                                 if(!$_) {
 902                                                         $_ = $filename;
 903                                                         s/^\d+-([^-]+)-//;
 904                                                         s/_/ /g;
 905                                                         s/\b(\w)/\U\1/g;
 906                                                 }
 907                                                 $track{"$dirname/$filename"} = $_;
 908                                                 #print STDERR "{$dirname/$filename} = $_\n";
 909                                                 #print qq~\$track{"$dirname/$filename"} = $_;\n~ if /magic/i;
 910                                                 $album{"$dirname/$filename"} = $album;
 911                                                 #print STDERR "$dirname/$filename $album\n";
 912                                         }
 913                                         last unless /\S/;
 914                                 }
 915                         }
 916                 }
 917                 close ALB;
 918         }
 919 };
 920
 921 sub extract_artist_title($\%) {
 922         my ($file, $info) = @_;
 923         my ($a, $t, $tr, $alb);
 924         local *F;
 925
 926         $info->{info_origin} = "filename";
 927
 928         # cut path
 929         $file =~ s|(.*)/||;
 930         my $p = $1;
 931
 932         # cut extension
 933         $file =~ s/(.*)\..*/\1/;
 934
 935         if(-e "$p/.andre" || ($file !~ /-/ && $file =~ /\..*\./)) {
 936                 # andre-notatie
 937                 $file =~ s/_ddd\.hq//;
 938                 $file =~ s/_/-/g;
 939                 $file =~ s/\./_/g;
 940                 $info->{info_origin} = "filename[andre]";
 941         }
 942
 943         my $pp = $p;
 944         $pp = '' if -e "$p/.noalbum";
 945         if(open F, "$p/.album") {
 946                 $alb = <F>;
 947                 close F;
 948                 chomp $alb;
 949         }
 950         $file =~ s/\s*$//;
 951         if($file =~ s/^\s*(\d\d)(\D)/\2/i ||            # nummer weg, 2 digits
 952                 $file =~ s/^\s*(\d{0,3})[^a-z0-9]+//i)  # nummer weg, 1-3 digits met separator
 953         {
 954                 $tr = $1;
 955         }
 956         $file =~ s/^[^a-z]+//i;
 957
 958         $pp =~ s|/+$||;
 959         $pp =~ s|.*/||;
 960
 961         if($file =~ /[\x80-\xff]{2,}/) {
 962                 my $dfile;
 963                 eval { $dfile = decode_utf8($file, Encode::FB_CROAK); };
 964                 if(!$@) {
 965                         $file = encode("iso-8859-1", $dfile);
 966                         $info->{info_origin} .= "(utf8)";
 967                 }
 968         }
 969
 970         if($file =~ /[_\s]*-[_\s]*/) {
 971                 ($a, $t) = ($`, $');
 972                 if($pp) { ($alb = $pp) =~ s/.*-[_\s]*//; }
 973         } else {
 974                 if(!$alb && $pp =~ s/-[_\s]*(.*)//) { $alb = $1; }
 975                 ($a, $t) = ($pp, $file);
 976         }
 977         if(-e "$p/.reverse") { ($a, $t) = ($t, $a); }
 978
 979         $info->{artist} = cleanup_name($a);
 980         $info->{title} = cleanup_name($t);
 981         $info->{album} = cleanup_name($alb);
 982         $info->{track} = $tr;
 983
 984         return 1;
 985 }
 986
 987 sub is_nfs($) {
 988         my ($file) = @_;
 989
 990         # major device number must be 0
 991         my $maj = (stat $file)[0] >> 8;
 992         return $maj == 0;
 993 }