soepkiptng_update

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