#!/usr/bin/perl -w
# Kurt Rosenfeld 2004
# GPL
use strict;
use GDBM_File;

my $musicdir = $ARGV[0] or die "RTFM";
my $FDMFDIR; 
my $NUM_BANDS = 4;
my $file_ptrn = '^[^.]';
my $db_file_ptrn = '~/.fdmf';

search_for_script_path(\$FDMFDIR);

my $SONICREDUCER = "$FDMFDIR/sonic_reducer";
die "Could not execute $SONICREDUCER." unless -x "$SONICREDUCER";

die "Unable to run spline.  Is it in your path?" if `spline /dev/null`;

my $OPENSSL = "openssl";
my $hello_hash = `echo "hello" | $OPENSSL md5`; 
chomp($hello_hash);
if ($hello_hash ne "b1946ac92492d2347c6235b4d2611184") {
	die "Could not execute openssl";
}

# We cache the table of filenames and their envelope spectra.
`cp "$db_file_ptrn" "$db_file_ptrn.$$" 2>/dev/null`;

tie my %DB, 'GDBM_File', glob("$db_file_ptrn"), &GDBM_WRCREAT|&GDBM_SYNC, 0640;
# If your perl/GDBM can't do SYNC mode, comment the line above and use this:
#tie my %DB, 'GDBM_File', glob("$db_file_ptrn"), &GDBM_WRCREAT, 0640;

# Recurse through the directory, searching for mp3s
my @filelist = recurse_from_dir($musicdir);

# Compare that filelist to the already-cached files in the database.
my @uncached = grep((not $DB{"$_"}), @filelist);

my $filecount = 0; 

print STDERR "Found ",$#filelist+1," files, ",$#uncached+1," uncached.\n";

# this loop will add any uncached files to the database
FILE: for my $file (@uncached) {
		my $escaped_filename = $file;
		$escaped_filename =~ s/(\W)/\\$1/g;
		my $file_md5 = `$OPENSSL md5 -binary $escaped_filename`;
		my $summary;
		print STDERR $filecount++, "/", $#uncached, " waiting on $file\n";
		# If an identical file is already indexed, reuse its summary.
		foreach my $k (keys %DB) {
			my $escaped_file_md5 = $file_md5;
			$escaped_file_md5 =~ s/(\W)/\\$1/g;
			if ($DB{$k} =~ m/^(.{96}).{4}$escaped_file_md5/s) {
				my $summary = $1;		
				print STDERR "Identical files (using cached summary):\n",
					"\t$file\n\t\tAND\n\t$k\n";
				$DB{$file} = join("", $summary, base_md5($file), $file_md5);
				next FILE;
			}
		}
		next FILE if sonic_reduce($file, \$summary);
		$DB{$file} = join("", $summary, base_md5($file), $file_md5);
} # post: %DB is complete

untie %DB;

#####################################################################
########################## THE END ##################################
#####################################################################

sub base_md5 {
		my $file = shift;
		my $base_md5 = `basename "$file" | $OPENSSL md5 -binary`;
		$base_md5 =~ s/^(....)(.*)/$1/s; # keep just the first four md5 bytes
		return $base_md5;
}


sub recurse_from_dir {
	my($dir) = @_;
	my @filelist;

	opendir(PARSEDIR, "$dir") || die "Couldn't open directory $dir: $!\n";
	
	foreach my $file (sort(readdir(PARSEDIR))) {
		my $fullname = $dir . "/" . $file;
		$fullname =~ s/\/+/\//g;
		if (-d $fullname && $file !~ /^\..*/) {
			push @filelist, recurse_from_dir($fullname);
		}
		elsif ($file =~ /$file_ptrn/i && -r $fullname)
		{
			$filelist[++$#filelist] = $fullname;
		}
	}

	closedir(PARSEDIR);

	return @filelist;
}


sub sonic_reduce {	
	# ARGUMENT: filename of music file
	# RETURN by REFERENCE: 768-bit string for fdmf database
	# RETURN VALUE: 0 for success, nonzero for nonsuccess.
	my $f =  shift;
	my $summary_ref = shift;
	my @SR;
	my $DECODE_CMD;
	return -1 if decode_cmd($f, \$DECODE_CMD);
	open(SR_PIPE, qq{$DECODE_CMD | $SONICREDUCER |}) ||
					die "pipe open for sonic_reduce failed: $!";
	@SR = <SR_PIPE>;	
	close(SR_PIPE);
	if ($#SR != 767) {
		print STDERR "sonic_reduce had trouble with $f.  Corrupt audio file?\n";
		return -2;
	}
	my @e = @SR[0   .. 255];	
	my @r = @SR[256 .. 511];	
	my @t = @SR[512 .. 767];	
	my $j = join("", quantize(@e), quantize(@r), quantize(@t)); 
	$$summary_ref = pack("b*", $j);
	return 0;
}

sub decode_cmd { 
	# This routine looks at the filename extension of a music file.
	# It returns the shell command for decoding it.
	my $f = shift;
	my $cmd_ref = shift;
	if ($f =~ m/.*\.mp3$/i) {
		$$cmd_ref = qq{mpg123 -s -q "$f" 2> /dev/null};
		return 0;
	}
	if ($f =~ m/.*\.ogg$/i) {
		$$cmd_ref = qq{ogg123 -d raw -f - "$f" 2>/dev/null};
		return 0;
	}
	else {
		print STDERR "Filename $f doesn't have an extension that we handle.\n";
		return -1;
	}
}

sub search_for_script_path {
	my $FDMF_DIR = shift; # a reference to the one in main()
	$_ = $0;
	if ( /^(.*)\// ) {
		$$FDMF_DIR = $1;
	} else {
		$_ = `which fdmf`;
		if ( /(.*)\// ) {
			$$FDMF_DIR = $1;
		} else {
			if ( -f "./fdmf" ) {
				$$FDMF_DIR = ".";
			}
		}
	}
}

sub quantize { 
	# one bit quantize with median value as threshold
	my @s;
	my $median = median(@_);
	foreach my $i (0 .. $#_) {
		$s[$i] = ($_[$i] > $median) ? 1 : 0;
	}
	return @s;
}

sub median {
	my $size;
	my $median;
	my @sorted = sort {$a <=> $b} @_;
	$size = scalar @sorted;
	if ($size % 2){
	    $median = $sorted[($size-1)/2];
	}
	else {
		$median = ($sorted[$size/2] + $sorted[($size/2)-1])/2;
	}
}

