raw2flac

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