#!/usr/bin/perl -Tw
#
# NAME
#   Tune
#
# SYNOPSIS
#   <form method=get action="/cgi/abc/Tune?F=type&X=ndx&U=url">
#
# REQUIRES 

require "cgilocal.pm";

# DESCRIPTION
#
# AUTHOR
#   John Chambers <jc@trillian.mit.edu>
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

$| = 1;			# Unbuffered STDOUT.
$V = 2;			# Verbose level.
$" = ',';		# Used in verbose messages.
$ONeills = 1;	# Enable O'Neill Project kludge/heuristic.
($me = $0) =~ s".*/"";

require "URLopen.pm";
require "HTTPcon.pm";

$mimetype = "text/html";
$logfile  = "$tmpdir/Tune$$.log";
$abcfile  = "$tmpdir/Tune$$.abc";
$psfile   = "$tmpdir/Tune$$.ps";
$epsfil0  = "$tmpdir/Tune$$.eps";
$epsfil1  = "$tmpdir/Tune$$001.eps";
$giffile  = "$tmpdir/Tune$$.gif";
$midifile = "$tmpdir/Tune$$.midi";
if (!open(L,">>$logfile")) {
	&send("<b>Can't write \"$logfile\" ($!)\n");
	&quit(1);
}
select L; $| = 1; select STDOUT;
$Lopen = 1;		# Logfile is open.

$RA = $ENV{REMOTE_ADDR} || '0.0.0.0';
$SV = $ENV{SERVER_NAME} || 'localhost';
#if ($RA eq '24.128.100.156' || $RA eq '127.0.0.1') {$V = 1}

$cgi = new CGI_Lite;
%data = $cgi->parse_form_data ();
chomp($cwd = `pwd`);
$data{ndxdir} = $ndxdir;

$title = $data{title};
$pattern = $data{pattern};
$URL = $data{U};
$Fmt = $data{F};
$X   = $data{X};
if (!$URL) {
	&lsend("### Called without a URL ###\n");
	&send("<p><b>Called without a URL</b>\n");
	quit(1);
}
$URL =~ s"^//*"http://$SV/";	# Expand "local" URLs.

($ss,$mm,$hh,$DD,$MM,$YY) = gmtime(time);
$dt = sprintf("%d-%02d-%02d %02d:%02d:%02d",1900+$YY,1+$MM,$DD,$hh,$mm,$ss);
$idlines = "H:$dt UT\t$URL\n";
if ($V>2) {
	&lsend("Environment:\n");
	for $x (sort keys %ENV) {$y = $ENV{$x}; &lsend("$x:\t$y\n")}
}
if ($V>1) {
	&lsend("From: $RA\n");
	&lsend("Data:\n");
	&lsend("D:\t$dt\n");
	for $x (sort keys %data) {$y = $data{$x}; &lsend("$x:\t$y\n")}
}
chdir $ndxdir;
chomp($cwd = `pwd`);
&lsend("Changed to $cwd\n") if $V>1; 

#if ($Fmt eq 'GIF') {
#	$mimetype = 'text/html';
#	&send("<p>Sorry, we can't produce GIF files on this server yet.<p>\n");
#	exit 0;
#}
if ($V>1) {
	&lsend("Request for:\n");
	&lsend("U=$URL\n");
	&lsend("F=$Fmt\n");
	&lsend("X=$X\n");
}
if ($ONeills && (index($URL,'jc/book/oneills/') >= 0)) {
#	$URL =~ s'/___/'/dev/';
	$isONeills = 1;
}

if (!URLopen(*U,$URL)) {
	&send("<br>Can't open URL \"$URL\" ($!)\n");
	&lsend("Can't open URL \"$URL\" ($!)\n");
	&send("<br>Here's the <a href=\"$tmpurl/Tune$$.log\">log file</a>.");
	&quit(1);
}
$intune = 0;
line:
	for $line (<U>) {
		&send($line) if $V>5;
		if ($URLhdr) {
			if ($line =~ /^\s*$/) {
				$URLhdr = 0;
			} else {
				&hdrline($line);
			}
		} elsif ($line =~ /^X:\s*(\d+)/) {
			$intune = ($1 == $X) ? 1 : 0;
		}
		if ($intune) {
			if ($line =~ /^\s+$/) {
				close U;
				$intune = 0;
				last line;
			}
			if ($isONeills && ($line =~ /^B:/) && !$extras) {
				&abcline("N:\n");
				&abcline("N:This is a pre-release from the O'Neill's Project. If you have a copy of O'Neill's, please proofread this, \n");
				&abcline("N:and if you find any discrepancies, send a note to the transcriber or to <jc\@trillian.mit.edu>\n");
				&abcline("N:\n");
#				&abcline($idlines);
				$extras = 1;
			}
			&abcline($line);
		}
	}
if (!@abc) {
	&send("<b>X:$X not found in $URL</b>\n");
	&lsend("X:$X not found in $URL\n");
	&send("<p>Headers:<pre>\n");
	&send(@hdr);
	&send("</pre>\n");
}
if ($Fmt eq 'ABC') {
	$mimetype = "text/vnd.abc";
	&send("\n");
	&send(@abc);
#	&send($idlines);
	&send("\n");
	&quit(0);
}

if ($Fmt eq 'PS' || $Fmt eq 'EPS' || $Fmt eq 'GIF' || $Fmt eq 'MIDI') {
	if (!open(ABC,">$abcfile")) {
		&send("<b>Can't write \"$abcfile\" ($!)\n");
		&lsend("Can't write \"$abcfile\" ($!)\n");
		&quit(1);
	}
	print ABC @abc;
#	print ABC $idlines if $Fmt ne 'EPS';
	print ABC "\n";
	close ABC;
} else {
	&send("Format <b>$Fmt</b> not implemented yet.<br>\n");
	&lsend("Format $Fmt not implemented yet.\n");
	&quit(1);
}

if ($Fmt eq 'PS' || $Fmt eq 'GIF') {
	$pscmd = "abc2ps $abcfile -n -o -O $psfile >>$logfile 2>&1";
	&lsend("pscmd=\"$pscmd\"\n") if $V>1;
	if ($V>1) {
		$which = `which abc2ps`;
		&lsend("abc2ps is $which\n") if $V>1;
	}
	@psout = `$pscmd`;
	if ($?) {
		&send("pscmd=\"$pscmd\" returned status $?.<br>\n");
		&send(@psout);
		&lsend("pscmd=\"$pscmd\" returned status $?.\n");
		&lsend(@psout);
		quit($?);
	}
	if (!open(PS,$psfile)) {
		&send("<b>Can't find postscript file \"$psfile\"</b>\n");
		&send("Here's the diagnostic output:\n");
		&send("<pre>\n");
		print @psout;
		&send("</pre>\n");
		&quit(1);
	}
	if ($Fmt eq 'PS') {
		$mimetype = "application/postscript";
		for $line (<PS>) {
			&send($line);
		}
	} elsif ($Fmt eq 'GIF') {
		close PS;
		$gifcmd = "(ps2gif $psfile) >>$logfile 2>&1";
		if ($V>1) {
			$which = `which abc2ps`;
			&lsend("abc2ps is $which");
		}
		@gifout = `$gifcmd`;
		if ($?) {
			&send("gifcmd=\"$gifcmd\" returned status $?<br>\n");
			&lsend(@gifout) if $V>1;
			&quit($?);
		}
		if (!open(GIF,$giffile)) {
			&send("<b>Can't find postscript file \"$giffile\"</b>\n");
			&send("Here's the diagnostic output:\n");
			&send("<pre>\n");
			print @gifout;
			&send("</pre>\n");
			&quit(1);
		}
		$mimetype = "image/gif";
		while (read(GIF,$line,10000)) {&send($line)}
		close GIF;
		quit(0);
	} else {
		&send("Format <b>$Fmt</b> not known.<br>\n");
		quit(1);
	}
} elsif ($Fmt eq 'EPS' || $Fmt eq 'GIF') {
	$epscmd = "abc2ps $abcfile -E -n -o -O $epsfil0 >>$logfile 2>&1";
	&lsend("epscmd=\"$epscmd\"\n") if $V>1;
	if ($V>1) {
		$which = `which abc2ps`;
		&lsend("abc2ps is $which\n") if $V>1;
	}
	@epsout = `$epscmd`;
	if ($?) {
		&send("epscmd=\"$epscmd\" returned status $?.<br>\n");
		&send(@epsout);
		&lsend("epscmd=\"$epscmd\" returned status $?.\n");
		&lsend(@epsout);
		quit($?);
	}
	unless (open(EPS,($epsfile=$epsfil0)) || open(EPS,($epsfile=$epsfil1))) {
		&send("<b>Can't find postscript file \"$epsfil0\" or \"$epsfil1\" </b>\n");
		&send("Here's the diagnostic output:\n");
		&send("<pre>\n");
		print @epsout;
		&send("</pre>\n");
		&quit(1);
	}
	if ($Fmt eq 'EPS') {
		$mimetype = "application/postscript";
		for $line (<EPS>) {
			&send($line);
		}
	} elsif ($Fmt eq 'GIF') {
		close EPS;
		$gifcmd = "(eps2gif $epsfile) >>$logfile 2>&1";
		if ($V>1) {
			$which = `which abc2ps`;
			&lsend("abc2ps is $which");
		}
		@gifout = `$gifcmd`;
		if ($?) {
			&send("gifcmd=\"$gifcmd\" returned status $?<br>\n");
			&lsend(@gifout) if $V>1;
			&quit($?);
		}
		if (!open(GIF,$giffile)) {
			&send("<b>Can't find postscript file \"$giffile\"</b>\n");
			&send("Here's the diagnostic output:\n");
			&send("<pre>\n");
			print @gifout;
			&send("</pre>\n");
			&quit(1);
		}
		$mimetype = "image/gif";
		while (read(GIF,$line,10000)) {&send($line)}
		close GIF;
		quit(0);
	} else {
		&send("Format <b>$Fmt</b> not known.<br>\n");
		quit(1);
	}
} elsif ($Fmt eq 'MIDI') {
	$midicmd = "abc2midi $abcfile -v -o $midifile >>$logfile 2>&1";
	&lsend("midicmd=\"$midicmd\"\n") if $V>1;
	if ($V>1) {
		$which = `which abc2midi`;
		&lsend("abc2midi is $which\n");
	}
	@midiout = `$midicmd`;
#	if ($?) {
#		&send("midicmd=\"$midicmd\" returned status $?<br>\n");
#		&send("Here's the <a href=\"$tmpurl/Tune$$.log\">log file</a>.<br>\n");
#		quit($?);
#	}
	if (!open(MIDI,$midifile)) {
		&send("<b>Can't find postscript file \"$midifile\"</b>\n");
		&send("midicmd=\"$midicmd\"<br>\n");
		&send("Exit status was $?<br>\n");
		&send("Here's the diagnostic output:\n");
		&send("<pre>\n");
		print @midiout;
		&send("</pre>\n");
		&quit(1);
	}
	$mimetype = "audio/midi";
	while (read(MIDI,$line,10000)) {&send($line)}
} else {
	&send("Format <b>$Fmt</b> not implemented yet.<br>\n");
	&quit(1);
}
quit(0); 

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub abcline {
	local($line);
line:
	for $line (@_) {
		if ($HTML) {
			if ($line =~ s"^<[/\w]+>"") {
			} elsif ($line =~ s"<[/\w]+>\s+$"\n") {
			}
			next line if ($line =~ /^\s+$/);
		}
		if ($idlines && ($line =~ /^K:/)) {
			push @abc, $idlines;
			$idlines = '';
		}
		push @abc, $line;
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub hdrline {
	local($line) = @_;
	if ($line =~ /^content-type:\s*(.*)/i) {
		if ($1 eq 'text/html') {
			$HTML = 1;		# Bad news!
		}
	}
	push @hdr, $line;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub lsend {
	print L @_ if $Lopen;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub quit {
	local($s) = @_;
	&lsend("$me: quit($s) giffile=\"$giffile\ psfile=\"$psfile\" epsfile=\"$epsfile\" abcfile=\"$abcfile\" logfile=\"$logfile\"\n") if $V>0;
	unless ($s) {
		if ($V<3 && -f $midifile) {unlink $midifile; &lsend("$me: unlinked \"$midifile\"\n")}
		if ($V<3 && -f $giffile)  {unlink $giffile ; &lsend("$me: unlinked \"$giffile\"\n")}
		if ($V<3 && -f $psfile)   {unlink $psfile  ; &lsend("$me: unlinked \"$psfile\"\n")}
		if ($V<3 && -f $epsfile)  {unlink $epsfile ; &lsend("$me: unlinked \"$epsfile\"\n")}
		if ($V<3 && -f $epsfil0)  {unlink $epsfil0 ; &lsend("$me: unlinked \"$epsfil0\"\n")}
		if ($V<3 && -f $epsfil1)  {unlink $epsfil1 ; &lsend("$me: unlinked \"$epsfil1\"\n")}
		if ($V<3 && -f $abcfile)  {unlink $abcfile ; &lsend("$me: unlinked \"$abcfile\"\n")}
		if ($V<2 && -f $logfile)  {unlink $logfile ; &lsend("$me: unlinked \"$logfile\"\n")}
		system "find $tmpdir -name 'Tune*' -atime +3 -exec rm -f {} ';'" if -d $tmpdir;
	}
	&lsend("$me: quit($s)\n") if $V>0;
	exit $s;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub send {
	print "Content-type: $mimetype\n\n" if !$hdrDone++;
	print @_;
}