#!/usr/bin/perl
#
#	gpsh
#	A script to start playing files from your music archive
#	by grepping on their filename, or title (in case of mixes).
#	released in the Public Domain
#	written by Jan Engelhardt, 2010
#
use Data::Dumper;
use File::Find::Rule;
use Getopt::Long;
use strict;
my @opt_mplayer;
my $opt_nomixes;
my $opt_verbose;
my @meta_exts = qw(.txt .m3u .tls .lyr .lop);

&main();

sub main
{
	my $opt_idxfile = "index.m9u",
	my $opt_shuffle = 1;
	my $opt_listonly;
	my $rebuild_index;
	my $index;
	my $vbr_map;
	my $queue;

	$SIG{INT} = $SIG{QUIT} = sub { exit(0); };

	&Getopt::Long::Configure(qw(bundling pass_through));
	&GetOptions(
		"F" => \$opt_idxfile,
		"b" => \$rebuild_index,
		"l" => \$opt_listonly,
		"x" => \$opt_nomixes,
		"z" => sub { $opt_shuffle = 0 },
		"v" => \$opt_verbose,
		"O=s" => sub {
			if ($_[1] =~ s/^M,//) {
				push(@opt_mplayer, $_[1]);
			}
		},
	);
	if ($opt_listonly) {
		$opt_verbose = 1;
	}
	if (scalar(@ARGV) == 0) {
		@ARGV = ("");
	}
	foreach my $arg (@ARGV) {
		if (substr($arg, 0, 1) ne "-") {
			next;
		}
		print STDERR "\"$arg\" not recognized as option, ",
			"interpreting it as search keyword instead.\n";
	}

	if ($rebuild_index) {
		($index, $vbr_map) = &index_rebuild($opt_idxfile);
	} elsif (!-e $opt_idxfile) {
		print STDERR "[$$] No index file found at current level\n";
		($index, $vbr_map) = &index_rebuild($opt_idxfile);
	} elsif (-M $opt_idxfile > 1 && $opt_listonly) {
		print STDERR "[$$] Index file older than a day\n";
		($index, $vbr_map) = &index_rebuild($opt_idxfile);
	} elsif (-M $opt_idxfile > 1) {
		($index, $vbr_map) = &index_read($opt_idxfile);
		$queue = &queue_select($index, \@ARGV);
		# Avoid backgrounding if we have nothing to play
		if (scalar(@$queue) > 0) {
			print STDERR "[$$] Index file older than a day\n";
			&schedule(\&index_rebuild, $opt_idxfile);
		} else {
			($index, $vbr_map) = &index_rebuild($opt_idxfile);
			$queue = &queue_select($index, \@ARGV);
		}
	} else {
		($index, $vbr_map) = &index_read($opt_idxfile);
	}

	if (!defined($queue)) {
		$queue = &queue_select($index, \@ARGV);
	}
	if ($opt_listonly) {
		return;
	}
	@$queue = sort { $a->{title} cmp $b->{title} } @$queue;
	if ($opt_shuffle) {
		@$queue = sort s_random @$queue;
	}
	&queue_play($queue, $vbr_map);
}

sub basename
{
	my $s = shift @_;
	$s =~ s{.*/}{}s;
	return $s;
}

sub queue_select
{
	my($index, $argv) = @_;
	my $queue = [];

	print "[$$] Index has ", scalar(@$index), " entries\n";
	foreach my $arg (@$argv) {
		push(@$queue, grep {
			$_->{title} =~ /$arg/i &&
			(!$opt_nomixes || $_->{ofs} == 0)
		} @$index);
	}
	if ($opt_verbose) {
		foreach (@$queue) {
			print "[$$]   \\_ $_->{title}\n";
		}
	}
	return $queue;
}

sub filename_nonext
{
	return (shift(@_) =~ /^(.*)\.[^\.]+$/)[0];
}

sub filename_ext
{
	my($ext) = (shift(@_) =~ /(\.[^\.]+)$/);
	return $ext;
}

sub filename_meta
{
	my $ext = shift @_;

	foreach my $t (@meta_exts) {
		if ($ext eq $t) {
			return 1;
		}
	}
	return 0;
}

sub filename_timidity
{
	my $ext = shift @_;

	foreach my $t (qw(.mid .mus .mod .669 .s3m .xm .it)) {
		if ($ext eq $t) {
			return 1;
		}
	}
	return 0;
}

sub queue_play
{
	my $queue = shift @_;
	my $vbr_map = shift @_;

	foreach my $entry (@$queue) {
		my $file = $entry->{file};
		my $ext = &filename_ext($file);
		$ext = lc $ext;

		print STDERR "\e[1;31m", $entry->{title}, "\e[0m\n"; # ]]
		if (&filename_timidity($ext)) {
			# my $t = $opt_verbose ? "t" : "";
			system "timidity", "-Os", "-idt", $file;
			next;
		} elsif ($file eq ".umx") {
			&play_umx($file);
			next;
		}
		if (exists $vbr_map->{$file}) {
			if ($opt_nomixes) {
				print STDERR "\e[31m(VBR file and reindexing disabled)\e[0m\n";
			} else {
				$file = &workaround_mp3vbr($file);
			}
		}
		if ($entry->{ofs} > 0) {
			--$entry->{ofs};
		}
		system "mplayer", "-vo", "null", $file, "-ss", $entry->{ofs}, @opt_mplayer;
	}
}

sub workaround_mp3vbr
{
	# MPlayer cannot properly seek in MP3 VBR streams.
	# Create an index file...
	my $ifile = shift @_;
	my $ofile = $ifile;
	my $tmpdir = "/tmp/psh";

	$ofile =~ s{/}{__}gs;
	$ofile = "$tmpdir/$ofile";
	if (-e $ofile) {
		return $ofile;
	}
	if (!-e $tmpdir) {
		if (!mkdir($tmpdir)) {
			print "[$$] Could not create $tmpdir: $!\n";
			return $ifile;
		}
	}
	system "mkvmerge", "-o", $ofile, $ifile;
	return $ofile;
}

sub play_umx
{
	my $name = shift @_;
	my $buffer;

	if (!open(IN, "< $name")) {
		warn "[$$] Could not open $name: $!\n";
		return;
	}

	my $of = "/tmp/playmuch-$$.it";
	open(OUT, "> $of");
	read(IN, $buffer, 256);
	$buffer =~ s{^.*?(?=IMP|SCRM|Extended Module)}{}ogs;
	print OUT $buffer;
	while (read(IN, $buffer, 65536)) {
		print OUT $buffer;
	}
	close IN;
	close OUT;

	system "timidity", "-Os", "-id".($opt_verbose ? "t" : ""), $of;
	unlink $of;
}

#
# Run a sub in the background.
#
sub schedule
{
	my $sub = shift @_;
	my $pid = fork();

	$SIG{CHLD} = "IGNORE";
	if (!defined($pid)) {
		die "[$$] Could not schedule subprocess: $!";
		return 0;
	} elsif ($pid == 0) {
		&$sub(@_);
		exit(0);
	}
}

sub audio_file_for
{
	my($file) = (shift(@_) =~ m{([^/]*)\.tls$});
	my $dir = $`;
	if ($dir eq "") {
		$dir = ".";
	}
	my $obj = File::Find::Rule->file();
	foreach my $t (@meta_exts) {
		$obj->not_name("*$t");
	}
	my @a = $obj->name("$file.*")->in($dir);
	return shift @a;
}

sub index_rebuild
{
	my $idxfile = shift @_;
	local(*DB, *FH);
	my @audio;
	my $track_list = [];
	my $vbr_map = {};

	print "[$$] Rebuilding index\n";
	@audio = File::Find::Rule->not_symlink()->file()->in(".");

	foreach my $file (@audio) {
		my $ext = &filename_ext($file);
		if (&filename_meta($ext)) {
			next;
		}
		push(@$track_list, {title => "/".&filename_nonext($file),
		     file => $file, ofs => 0});
	}

	foreach my $file (grep(/\.tls$/, @audio)) {
		my $af = &audio_file_for($file);
		if (!defined($af)) {
			print "[$$]  \\__ No audio for $file\n";
			next;
		}
		if (!open(FH, "< $file")) {
			next;
		}
		my $bf = $af;
		$bf =~ s{(.*)\..+$}{$1};
		while (defined(my $line = <FH>)) {
			chomp $line;
			if ($line =~ m{^<<VBR>>}) {
				# vivify hash entry, but don't waste
				# memory for a value like 1
				$vbr_map->{$af} = undef;
				next;
			}
			my($h, $m, $s, $title) =
			    ($line =~ m{^\[\s*(?:(\d+):)?(\d+):(\d+)\]\s+(.+)});
			if (!defined($title)) {
				next;
			}
			$s = $h * 3600 + $m * 60 + $s;
			my $entry = {
				title => "/$bf,$title",
				file => $af,
				ofs => $s,
			};
			push(@$track_list, $entry);
		}
		close FH;
	}

	if (!open(DB, "> $idxfile")) {
		die "[$$] Could not write to $idxfile: $!\n";
	}
	my $dd = Data::Dumper->new([$track_list, $vbr_map]);
	print DB $dd->Dump();
	close DB;
	return ($track_list, $vbr_map);
}

sub index_read
{
	my $idxfile = shift @_;
	do $idxfile || die "[$$] Could not read from $idxfile: $!\n";
	return ($::VAR1, $::VAR2);
}

sub s_random
{
	return int(rand 2) ? 1 - (int(rand(256 ** 4)) % 3) :
	       ((time() ^ $$ ^ int(rand(256 ** 4))) % 3) - 1;
}
