soepkiptng_update_gain

   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 use Cwd 'abs_path';
  21 use DBI;
  22 use Getopt::Std;
  23
  24
  25 # try with att==0
  26 # try with att=1, double att until clipping=0
  27 # successive approximation
  28
  29 sub clip($) {
  30         my ($gain) = @_;
  31
  32         sysseek STDIN, 0, 0;
  33         my $clipped = undef;
  34         open M, "madplay --ignore-crc -a $gain -owav:/dev/null - 2>&1 |";
  35         while(<M>) {
  36                  /(\d+) clipped sample/ and $clipped = $1;
  37         }
  38         close M;
  39         $? and die "madplay failed, skipping file\n";
  40         warn "trying $gain -> $clipped\n";
  41         return $clipped;
  42 }
  43
  44 sub doit($) {
  45         my ($f) = @_;
  46
  47         warn "testing $f\n";
  48         my $gain_min = -1;
  49         my $gain_max = 1;
  50         while(clip($gain_max) == 0) {
  51                 $gain_min = $gain_max;
  52                 $gain_max *= 2;
  53                 if($gain_max > 35) {
  54                         $dbh->do("UPDATE song SET gain=18000 WHERE filename=?", undef, $f);
  55                         return;
  56                 } elsif($gain_max > 18) {
  57                         $gain_max = 18;
  58                 }
  59         }
  60         if($gain_min < 0) {
  61                 while(clip($gain_min) > 0) {
  62                         if($gain_min < -175) {
  63                                 return;
  64                         }
  65                         $gain_min *= 2;
  66                 }
  67         }
  68
  69         while(($gain_max - $gain_min) > 0.05) {
  70                 $gain = ($gain_min + $gain_max) / 2;
  71                 if(clip($gain)) {
  72                         $gain_max = $gain;
  73                 } else {
  74                         $gain_min = $gain;
  75                 }
  76         }
  77         printf "%f %s\n", $gain_min, $f;
  78         my $g = int($gain_min * 1000 + 0.5);
  79         if($g < -32768) { $g = 32768; }
  80         elsif($g > 32767) { $g = 32767; }
  81         $dbh->do("UPDATE song SET gain=? WHERE filename=?", undef, $g, $f);
  82 }
  83
  84
  85 # find program directory
  86 $_ = $0;
  87 while(-l) {
  88         my $l = readlink or die "readlink $_: $!\n";
  89         if($l =~ m|^/|) { $_ = $l; } else { s|[^/]*$|/$l|; }
  90 }
  91 m|(.*)/|;
  92 my $progdir = abs_path($1);
  93
  94 require "$progdir/soepkiptng.lib";
  95
  96 getopts('c:');
  97
  98 read_configfile(\%conf, $opt_c);
  99
 100 $| = 1;
 101
 102 $dbh = connect_to_db(\%conf);
 103
 104 $sth = $dbh->prepare(
 105         "SELECT filename FROM song WHERE present AND gain IS NULL AND filename LIKE '/%'" .
 106         "AND (encoding LIKE 'mp3%' OR encoding LIKE 'mpeg%layer%')");
 107 $sth->execute();
 108 while($_ = $sth->fetchrow_hashref) {
 109         -e $_->{filename} or next;
 110         open STDIN, $_->{filename} or do {
 111                 warn "$_->{filename}: $!\n";
 112                 next;
 113         };
 114         eval { doit($_->{filename}); };
 115         warn $@ if $@;
 116         close STDIN;
 117 }