flac2lame perl script threaded
Posted by Anonymous on Tue 11th Sep 2012 03:06
raw | new post

#!/usr/bin/perl

use 5.14.0;
use strict;
use warnings;
use Cwd qw(abs_path cwd);
use File::Path qw(make_path);
use File::Basename qw(basename dirname);

use threads qw(yield);
use threads::shared;
use Thread::Queue;

my $total :shared = 0;
my $disk_size = 1000000000;

my @dirs;
my %pcm :shared;
my @opts = ('-q 0', '-V 2', '--silent', '--id3v2-only');
my $q = Thread::Queue->new();

if (!$ARGV[0] || ! -d $ARGV[0]) {
        say "Usage: " . basename($0) . " [FLAC directory]";
        exit;
}

foreach my $arg (@ARGV) {
        my $src = abs_path($arg);
        if (-d $src) {
                getdirs($src);
        }
}

sub gettags {
        my $fn = quotemeta(shift);
        my (%alltags, @mflac);
        open(OUTPUT, '-|', qq{metaflac --no-utf8-convert --export-tags-to=- $fn}) || die "can't run metaflac: $!";
        chomp(@mflac = (<OUTPUT>));
        foreach (@mflac) {
                my @tag = split('=');
                my $tagname = lc($tag[0]) or say $fn;

                if ($alltags{$tagname}) { next; }
                elsif ($tag[1]) {
                        $alltags{$tagname} = $tag[1];
                } else {
                        $alltags{$tagname} = 'null';
                }
        }
        close(OUTPUT) || die "couldn't close metaflac: $!";
        return %alltags;
}

sub getdirs {

        my $dn = shift;

        open(FIND, '-|', qq(find -L "$dn" -name "*" -type d))
        or die "Can't run 'find': $!";
        push(@dirs, (<FIND>));
        chomp(@dirs);
        close(FIND) or die "Can't close 'find': $!";
}

sub getfiles {
        my $dn = shift;
        my @files;
        opendir(my $dh, $dn) or die "Can't open directory '$dn': $!";
        foreach (sort(readdir $dh)) {
                my $fn = "$dn/$_";
                if (/.flac$/ && -f $fn) {
                        push(@files, $fn);
                }
        }
        closedir $dh or die "Can't close directory '$dn': $!";
        return @files;
}

sub name {

        my $fn = shift;
        my %t = gettags($fn);
        my $tref = \%t;
        my $dest;

        checktags($fn, $tref);

        my @dest = ('home', 'sir', 'lame', $t{albumartist}, $t{album});
        foreach my $n (0 .. (scalar(@dest) - 1)) {
                $dest[$n] =~ tr!\\/<>|:;$*"'!!d;
        }
        { local $" = '/'; $dest = "/@{dest}/"; }

        make_path($dest);

        my $newfn = sprintf('%s-%02s. %s.mp3', $t{discnumber}, $t{tracknumber}, $t{title});
        $newfn =~ tr!\\/<>|:;$*"'!!d;
        $newfn = $dest . $newfn;

        return($newfn, $tref);
}

sub decode {

        my $fn = shift;
        local $/;
        open(FLAC, '-|:raw', qq{flac --silent --stdout --decode "$fn"}) || die "can't run 'flac': $!";
        chomp($pcm{$fn} = <FLAC>);
        close(FLAC) || die "couldn't close 'flac': $!";

        lock($total);
        $total += length($pcm{$fn});
}

sub checktags {
        my $fn = shift;
        my $tref = shift;
        my %t = %{$tref};
        foreach my $tag ('discnumber', 'albumartist', 'album', 'tracknumber', 'title') {
                if (! $t{$tag}) {
                        say "${fn}: missing '$tag' tag.";
                        exit;
                }
        }
}

#say "Starting threads...";
my @threads;
for my $i (1..4) {
        push(@threads, threads->create(\&lame));
}

sub lame {

        my $started = 0;

        while ($q->pending() == 0 && $started == 0) {
                yield();
                next;
        }

        $started++;

        my $tid = threads->tid();

        while (my $fn = $q->dequeue_nb()) {

                my $oldfn = $fn;
                my ($newfn, $tref) = name($fn);
                my %t = %{$tref};

                foreach my $tag ('artist', 'title', 'album', 'tracknumber', 'date') {
                        if ($t{$tag}) {
                                given($tag) {
                                        when ('artist') {
                                                push(@opts, '--ta');
                                                push(@opts, "\"$t{artist}\"");
                                        }
                                        when ('title') {
                                                push(@opts, '--tt');
                                                push(@opts, "\"$t{title}\"");
                                        }
                                        when ('album') {
                                                push(@opts, '--tl');
                                                push(@opts, "\"$t{album}\"");
                                        }
                                        when ('tracknumber') {
                                                push(@opts, '--tn');
                                                push(@opts, "\"$t{tracknumber}\"");
                                        }
                                        when ('date') {
                                                $t{date} =~ /[0-9]{4}/;
                                                push(@opts, '--ty');
                                                push(@opts, "\"$t{date}\"");
                                        }
                                }
                        }
                }

                say "thread${tid} ${fn}: encoding...";
                open(LAME, '|-:raw', qq{lame @opts - "$newfn"}) || die "can't run 'lame': $!";
                print LAME $pcm{$oldfn};
                close(LAME) || die "couldn't close 'lame': $!";

                lock(%pcm);
                lock($total);
                $total -= length($pcm{$oldfn});
                delete($pcm{$oldfn});
        }
}

foreach my $dn (sort(@dirs)) {

        my @files = getfiles($dn);

        my @stat;
        my $album_size = 0;

        if (scalar(@files) == 0) {
                next;
        }

        # Check the size of the album to make more informed
        # decisions on when to yield in the next loop
        foreach my $fn (@files) {
                @stat = stat($fn);
                $album_size += $stat[7];
        }

        #say "\nDecoding files and storing in RAM...\n";
        foreach my $fn (@files) {

                if ($album_size > 600000000) { goto(DECODE); }

                until ($total < $disk_size) {
                        yield();
                }

                DECODE: decode($fn);
        }

        #say "\nEncoding PCM data to LAME MP3...\n";

        #say "Enqueueing files";

        foreach my $fn (@files) {
                $q->enqueue($fn);
        }

}

foreach my $t (threads->list()) { $t->join(); }
say "All threads joined";