flac2lame perl script threaded
Posted by Anonymous on Wed 12th Sep 2012 10:50
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. 4 threads of 'lame'
# are started and 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 @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;

        local $/;
        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 %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 = ('home', $ENV{USER}, 'lame', $ct{albumartist},
        $ct{album});
        { local $" = '/'; $dest = "/@{dest}/"; }

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

        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 $/;
        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($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 .. $cpu_count) {
        push(@threads, threads->create(\&lame));
}

sub lame {

        my $started = 0;

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

        $started++;

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

        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} ${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});
        }
}

foreach my $dn (@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];
        }

        foreach my $fn (@files) {

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

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

                DECODE: decode($fn);
        }

        #say "Enqueueing files";
        foreach my $fn (@files) {
                $q->enqueue($fn);
        }

}

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