#!/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";