raw2flac

   1 #!/usr/bin/perl -w
   2
   3 ############################################################################
   4 # soepkiptng (c) copyright 2000 Eric Lammerts <eric@lammerts.org>.
   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 as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # A copy of the GNU General Public License is available on the World Wide Web
  17 # at `http://www.gnu.org/copyleft/gpl.html'.  You can also obtain it by
  18 # writing to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 # Boston, MA 02111-1307, USA.
  20 ############################################################################
  21
  22 my $progdir;
  23 BEGIN {
  24         use Cwd qw'cwd abs_path';
  25
  26         # find program directory
  27         $_ = $0;
  28         while(-l) {
  29                 my $l = readlink or die "readlink $_: $!\n";
  30                 if($l =~ m|^/|) { $_ = $l; } else { s|[^/]*$|/$l|; }
  31         }
  32         m|(.*)/| or die;
  33         $progdir = abs_path($1);
  34
  35         unshift @INC, "$progdir/lib";
  36 }
  37 use DBI;
  38 use Digest::MD5;
  39 use Getopt::Std;
  40
  41 require "$progdir/soepkiptng.lib";
  42
  43 our ($opt_d, $opt_v, $opt_c, $opt_h, $opt_s);
  44 getopts('dvc:hs');
  45
  46 $opt_h and die <<EOF;
  47 usage: raw2flac [-dvsh] [-c configfile] file.raw...
  48
  49 options:
  50 -d            : delete original after successful compression
  51 -v            : verbose operation
  52 -c configfile : SoepkipTNG configfile
  53 -h            : print this help text
  54 -s            : put output files in current directory
  55 EOF
  56
  57 my %conf;
  58 read_configfile(\%conf, $opt_c);
  59
  60 $ENV{PATH} = "$progdir/bin:$ENV{PATH}";
  61 $cwd = cwd;
  62
  63 @flac_stdin = qw'flac -s -8 --endian=little --channels=2 --bps=16
  64         --sample-rate=44100 --sign=signed --force-raw-format';
  65 $flacd_stdin = 'flac -sdc --endian=little --sign=signed --force-raw-format -';
  66
  67 sub convert_dir($);
  68 sub convert_raw($);
  69
  70 $dbh = DBI->connect("DBI:$conf{db_type}:$conf{db_name}:$conf{db_host}",
  71         $conf{db_user}, $conf{db_pass})
  72         or die "can't connect to database";
  73
  74 sub cleanup {
  75         unlink $tmpfile or warn "$tmpfile: $!\n";
  76         exit 1;
  77 }
  78
  79 $SIG{'INT'} = \&cleanup;
  80 $SIG{'QUIT'} = \&cleanup;
  81 $SIG{'TERM'} = \&cleanup;
  82
  83
  84 foreach (@ARGV) {
  85         if(-d $_) {
  86                 convert_dir($_);
  87         } else {
  88                 convert_raw($_);
  89         }
  90 }
  91
  92
  93 sub convert_dir($) {
  94    my ($wdir) = @_;
  95
  96    print "Scanning for .raw files in $wdir\n" if $opt_v;
  97
  98    opendir WDIR,$wdir or die "Can not open directory $wdir: $!\n";
  99    my @files = sort readdir WDIR;
 100    closedir WDIR;
 101
 102    foreach (@files) {
 103         next if $_ eq "." || $_ eq "..";
 104         if(/\.raw$/i) {
 105                 convert_raw("$wdir/$_");
 106 #               warn "test: $wdir/$_\n";
 107         } elsif(-d "$wdir/$_") {
 108                 convert_dir("$wdir/$_");
 109         }
 110    }
 111 }
 112
 113 sub convert_raw($) {
 114         my ($rawfile) = @_;
 115         my (@t, $t);
 116
 117         if($rawfile !~ m|^/|) { $rawfile = "$cwd/$rawfile"; }
 118         $rawfile =~ s!(^|/)(\./)+!$1!g;
 119
 120         (my $qfile = $rawfile) =~ s/(.*)\.\w+?$/$1.%/;
 121         $qfile =~ s~^(.*/)?(.*)~abs_path($1 || ".") . "/$2"~e;
 122         my $q = "SELECT title,artist.name,album.name,track" .
 123                 " FROM song,artist,album" .
 124                 " WHERE song.artist_id=artist.id AND song.album_id=album.id" .
 125                 " AND present AND filename LIKE ?";
 126         $sth = $dbh->prepare($q);
 127         $sth->execute($qfile)
 128                 or die "can't do sql command: " . $dbh->errstr;
 129
 130         my ($ti, $ar, $al, $tr);
 131         ($ti, $ar, $al, $tr) = $sth->fetchrow_array or do {
 132                 $qfile =~ s|.*/|%/|;
 133                 $sth->execute($qfile)
 134                         or die "can't do sql command: " . $dbh->errstr;
 135
 136                 ($ti, $ar, $al, $tr) = $sth->fetchrow_array or do {
 137                         warn "$rawfile: not found in dbase\n";
 138                 };
 139         };
 140
 141         @t = times;
 142         $t = $t[0] + $t[1] + $t[2] + $t[3];
 143
 144         print "\nPacking file $rawfile\n" if $opt_v;
 145         my $flacfile = $rawfile;
 146         $flacfile =~ s/\.raw$/.flac/i;
 147         if($opt_s) { $flacfile =~ s|.*/||; }
 148
 149         if(-e $flacfile) {
 150                 warn "$flacfile: file exists\n";
 151                 return;
 152         }
 153         $tmpfile = "$flacfile.tmp";
 154
 155         my @flacargs = ();
 156         if($ti) { push @flacargs, "-Ttitle=$ti"; print "* title=$ti\n" if $opt_v; }
 157         if($ar) { push @flacargs, "-Tartist=$ar"; print "* artist=$ar\n" if $opt_v; }
 158         if($al) { push @flacargs, "-Talbum=$al"; print "* album=$al\n" if $opt_v; }
 159         if($tr) { push @flacargs, "-Ttracknumber=$tr"; print "* track=$tr\n" if $opt_v; }
 160
 161         open IN, $rawfile or do {
 162                 warn "$rawfile: $!\n";
 163                 return;
 164         };
 165         if(open(OUT, "|-") == 0) {
 166                 exec @flac_stdin, @flacargs, "-o$tmpfile", "-";
 167                 die join(" ", @flac_stdin, @flacargs) . " -o$tmpfile -: $!\n";
 168         }
 169
 170         my $ctx = Digest::MD5->new;
 171         while(read IN, $buf, 4096) {
 172                 $ctx->add($buf);
 173                 print OUT $buf or die;
 174         }
 175         close IN;
 176         close OUT or die;
 177         $digest = $ctx->digest;
 178
 179         @t = times;
 180         $t = $t[0] + $t[1] + $t[2] + $t[3] - $t;
 181
 182         print "checking $tmpfile...\n" if $opt_v;
 183
 184         open STDIN, $tmpfile or die "$tmpfile: $!\n";
 185         open IN, "$flacd_stdin|";
 186         while(read IN, $buf, 4096) {
 187                 $ctx->add($buf);
 188         }
 189         close IN;
 190         $digest2 = $ctx->digest;
 191
 192         if($digest eq $digest2) {
 193                 if(rename $tmpfile, "$flacfile") {
 194                         printf "$rawfile: compression done (%d%% left; %dm%02ds)\n",
 195                                 100.0 * (-s $flacfile) / (-s $rawfile),
 196                                 $t / 60, $t % 60;
 197                         if($opt_d) {
 198                                 print "removing $rawfile\n" if $opt_v;
 199                                 unlink "$rawfile" or warn "unlink $rawfile: $!\n";
 200                         }
 201                 } else {
 202                         warn "rename $tmpfile -> $flacfile: $!\n";
 203                         unlink $tmpfile or die "unlink $tmpfile: $!\n";
 204                         exit 1;
 205                 }
 206         } else {
 207                 warn "$tmpfile: md5 mismatch\n";
 208                 unlink $tmpfile or die "unlink $tmpfile: $!\n";
 209                 exit 1;
 210         }
 211 }