flac2lame perl script threaded
Posted by Anonymous on Sat 15th Sep 2012 12:43
raw | new post

#!/usr/bin/perl

# Copyright Â© 2012 Adam Nilsson
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

# This script decodes FLAC files into RAM up to the limit defined in
# $disk_size. The $total variable is used to count the total amount
# of data decoded and stored in RAM at any time.

# The script looks for the CPU core count in /proc/cpuinfo and starts
# as many threads of 'lame' as it finds cores. The threads are left
# waiting for files to be enqueued.

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

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

my $total :shared = 0;
my $disk_size = 1000000000;
my $end :shared;
my %decoded :shared;

my @dirs;
my %pcm :shared;
my @opts = ('-q 0', '-V 2', '--silent', '--id3v2-only');
my $q = Thread::Queue->new();
chomp(my $cpu_count = `grep -c "^processor" /proc/cpuinfo`);

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

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

sub gettags {
        my $fn = shift;
        my (%t, @mflac);
        open(OUTPUT, '-|',
        qq{metaflac --no-utf8-convert --export-tags-to=- "$fn"})
        or die "can't run metaflac: $!";

        chomp(@mflac = (<OUTPUT>));
        foreach (@mflac) {
                my @tag = split('=');
                my $tagname = lc($tag[0]) or say $fn;

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

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 (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 %ct = ( albumartist => $t{albumartist}, album => $t{album},
        discnumber => $t{discnumber}, tracknumber => $t{tracknumber},
        title => $t{title} );

        foreach my $tag (keys(%ct)) {
                $ct{$tag} =~ s/[[:punct:]]//g;
        }

        my @dest = ($ENV{HOME}, 'lame', $ct{albumartist},
        $ct{album});
        { local $" = '/'; $dest = "@{dest}/"; }

        unless (-d $dest) {
                make_path($dest) or warn "Can't make_path '$dest': $!";
                #system('mkdir', '-p', $dest) or warn "Can't run 'mkdir': $!";
        }

        my $newfn = sprintf('%s-%02s. %s.mp3', $ct{discnumber},
        $ct{tracknumber}, $ct{title});
        $newfn = $dest . $newfn;

        return($newfn, $tref);
}

sub decode {

        my $fn = shift;
        local $/; # Enable slurp mode.
        open(FLAC, '-|:raw', qq{flac --silent --stdout --decode "$fn"})
        or die "can't run 'flac': $!";
        chomp($pcm{$fn} = (<FLAC>));
        close(FLAC) || die "couldn't close 'flac': $!";
        lock(%decoded);
        lock($total);
        $decoded{$fn} = 1;
        $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;
foreach (1 .. $cpu_count) {
        push(@threads, threads->create(\&lame));
}

sub lame {

        while (!$q->pending() && !$end) {
                yield();
        }

        my $tid = threads->tid();
        my @old_opts = @opts;

        LOOP: 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', $t{artist}));
                                        }
                                        when ('title') {
                                                push(@opts, ('--tt', $t{title}));
                                        }
                                        when ('album') {
                                                push(@opts, ('--tl', $t{album}));
                                        }
                                        when ('tracknumber') {
                                                push(@opts, ('--tn', $t{tracknumber}));
                                        }
                                        when ('date') {
                                                $t{date} =~ /[0-9]{4}/;
                                                push(@opts, ('--ty', $t{date}));
                                        }
                                }
                        }
                }

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

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

        if (!$q->pending() && !$end) {
                yield();
                goto(LOOP);
        }
}

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

        my @files = getfiles($dn);

        if (!@files) {
                next;
        }

        foreach my $fn (@files) {

                decode($fn);

                # If the RAM disk is full, put decoded files in the queue,
                # and then yield until the LAME threads have cleared some RAM.

                while ($total > $disk_size) {
                        foreach my $fn (keys(%decoded)) {
                                $q->enqueue($fn);
                                lock(%decoded);
                                delete($decoded{$fn});
                        }
                        yield();
                }
        }

        foreach my $fn (keys(%decoded)) {
                $q->enqueue($fn);
                lock(%decoded);
                delete($decoded{$fn});
        }
}

$end = 1;

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