#!/usr/bin/perl -Tw

#NAME
#  submit - add file to web archive

#SYNOPSIS
#  <form method=POST action=".../submit">

#DESCRIPTION
#  This CGI script accepts a file from a <textarea> in a web form  and
#  adds its contents to a directory.

#  This particular incarnation is adapted to accepting ABC tunes  from
#  the  ABCsubmit.html  page.   The  <textarea>  is  named  "ABC".  In
#  addition, there are a number of extra single-line input widgets for
#  the  user's  name  and  email  address, and for the most common ABC
#  header lines.

#REQUIRES
#  If the following aren't found, modify @INC so they are found:

	push @INC, '.';
	$host = `hostname`;		# Get our host name
	$host =~ s/[\r\s]+$//;	# Strip off trailing white stuff
	$host =~ s/\..*//;		# Strip off everything after the first dot
	require "Vopt.pm";
	require "sendsubs.pm";	# Routines to send messages
	require "DT.pm";
if (-f "$host-cgilocal.pm") {
	require "$host-cgilocal.pm";
} else {
	require "cgilocal.pm";	# Where things are kept on this machine.
}
	require "outtune.pm";

#OPTIONS

#FILES

#  $abcdir/contrib/Title.abc
#    created for each T: title line.

#BUGS

#SEE ALSO

#  .../cgi/abc/ABCsubmit.html
#  .../cgi/abc/tune

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

$| = 1;
use strict;			# Paranoia.
no strict "vars";	# Allow global variables.
($me = $0) =~ s'.*/'' unless defined($me);
&Vopt($ENV{"V_$me"} || $ENV{"D_$me"} || $ENV{"T_$me"} || 2);

$mimetype = "text/html";
$logfile  = "$tmpdir/$me$$.log";
if (open(L,">>$logfile")) {
	select L; $| = 1; select STDOUT; $Lopen = 1;
	print L "\n$me $esep\n" if $V>2;
	print L "$me started with V=$V ", `date` if $V>0;
} else {
	&err("Can't write \"$logfile\" ($!)");
	exit 1;
}

use CGI;			# Standard CGI module.
use CGI::Carp		# Send errors to client.
	'fatalsToBrowser';
$query = new CGI;

if ($V>2) {
	&lsend("ENV:\n");
	for $e (sort keys %ENV) {
		$v = $ENV{$e};
		&lsend("\t$e = \"$v\"\n");
	}
	&lsend("ARGS:\n");
	@names = $query->param();
	if ($V>2) {
		for $n (sort @names) {
			if (@vals = $query->param($n)) {
				for $v (@vals) {
					&lsend("$n = \"$v\"\n");
				}
			} elsif ($v = $query->param($n)) {
				&lsend("$n = \"$v\"\n");
			} else {
				&lsend("$n = \"(NO VALUE)\"\n");
			}
		}
		&lsend("----\n");
	}
}
$ipad = $ENV{'REMOTE_ADDR'} || '0.0.0.0';
&lsend("ipad=\"$ipad\"\n") if $V>5;

$data = $query->param('data');
&lsend("data=\"$data\"\n") if $V>5;
unless (@data = split(/\n/,$data)) {
	&err("No data submitted for ABC tune");
	exit 1;
}

%mimetype = (
	'ABC'  => 'text/vnd.abc',
	'GIF'  => 'image/gif',
	'HTML' => 'text/html',
	'MIDI' => 'audio/midi',
	'PS'   => 'application/postscript',
);

if ($fmt = ($query->param('PS') || $query->param('GIF') || $query->param('MIDI'))) {
	&lsend("Request for $fmt output.\n");
	$abcfile = "$tmpdir/$me$$.abc";
	&lsend("Create ABC file \"$abcfile\"\n");
	unless (open(ABC,">$abcfile")) {
		&err("Can't write \"$abcfile\" ($!)");
		exit 1;
	}
	print ABC $data;
	close ABC;
	$url = "http://localhost$cgiurl/tune?F=$fmt&ndx=0&U=http://localhost$tmpurl/$me$$.abc";
	&lsend("url: $url\n");
	$cmd = "w3cat \"$url\"";
	&lsend("cmd: $cmd\n");
	$mimetype = $mimetype{$fmt} || 'text/plain';
    print "Content-type: $mimetype\n\n" if !$hdrDone++;
	system $cmd;
	if ($?) {&err("Got exit status $? from command\n$cmd")}
	exit $?;
}

&htmlhdr() if !$hdrDone++;

if ($V>2) {
	&lsend("TUNE:\n");
	for $line (@data) {
		&lsend("\t\"$line\"\n");
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# First we handle the common headers from the  form.   Any  that  are #
# present, we put out in a standard order.  The data area may include #
# headers, of course, and they will be produced  after  these.   Note #
# that  the  K: header isn't included here, because it must be at the #
# end of the headers.                                                 #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
for $H ('X','T','P','C','O','S','Z','R','M','L') {
	if ($h = $query->param($H)) {
		&lsend("$H: \"$h\"\n") if $V>2;
		push @tune, "$H: $h\n";
		$X = $X if ($H eq 'X');
	} else {
		&lsend("$H missing.\n") if $V>2;
	}
}
if ($T = $query->param('T')) {push @ttl, $T; push @title, $T}
$X = $query->param('X') || 0;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Next, we run through the data, copying the  headers  to  the  file. #
# When we encounter a K: line or a non-header, we switch to the music #
# phase, and just copy the rest of the data without examining it.     #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
$hdr = 1;
for $line (@data) {
	chomp($line);
	&lsend("==== \"$line\"\n") if $V>2;
	if ($hdr) {
		&lsend("HDR: \"$line\"\n") if $V>2;
		if ($line =~ "^\s*#") {
			&lsend("---: Comment.\n") if $V>2;
			# Comment lines just copied as-is.
		} elsif ($line =~ /^(\w):\s*(.*)$/) {
			$H = $1; $A = $2;
			&lsend("Hdr: H='$H' A=\"$A\"\n") if $V>2;
			if ($H eq 'K') {	# Is it a K: line?
				$hdr = 0;		# K: ends headers.
				&tuneident();
				$key = $2;		# Remember the key.
			} elsif ($H eq 'X') {
				$X = $A;		# Note the index number.
			} elsif ($H eq 'T') {
				$T = $A;		# Note the title(s).
				push @ttl, $A;
				push @title, $A;
			}
		} else {				# Not a header line?
			&lsend("---: No Match.\n") if $V>2;
			&lsend("---: key=\"$key\"\n") if $V>2;
			$hdr = 0;			# Now in music phase.
			&tuneident();
			unless ($key) {		# Make sure there's a key.
				$key = $query->param('K') || 'C';
				&lsend("key: \"$key\"\n") if $V>2;
				push @tune, "K: $key\n";
			}
		}
	} else {
		&lsend("ABC: \"$line\"\n") if $V>2;
	}
	push @tune, "$line\n";		# Send every line to file.
}

$condir = "$abcdir/contrib";
$ipadir = "$condir/$ipad";

mkdir($condir,0775) unless -d $condir;
mkdir($ipadir,0775) unless -d $ipadir;
chmod(0775,$condir);
chmod(0775,$ipadir);

&send("<br>Your contribution has been put into the directory\n");
&send("<a href=\"$abcurl/contrib/$ipad/\">contrib/$ipad/</a>.<br>\n");

@files = &outtune("$ipadir/");
if (@files) {
	$n = int(@files);
	$pl = ($n == 1) ? '' : 's';
	&send("<br><b>$n file$pl created:</b><br><ol>\n");
	for ($i = 0; $i < $n; $i++) {
		$file = @files[$i];
		$titl = @title[$i];
		$file =~ s"$abcdir"$abcurl";
		&send("<li><a href=\"$file\">$titl</a>\n");
	}
	&send("</ol>\n");
} else {
	&lsend("No titles found.\n") if $V>0;
}

&send("</body>\n");
&send("</html>\n");

exit 0;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 
sub htmlhdr {
	print "Content-type: $mimetype\n\n";
	print "<html>\n";
	print "<head>\n";
	print "<title>ABC tune contribution</title>\n";
	print "</head>\n";
	print "<body>\n";
	print "<center>\n";
	print "\t<b>ABC tune contribution</b>\n";
	print "<br>Log file: <a href=\"$tmpurl/$me$$.log\">$me$$.log</a>\n";
	print "</center>\n";
	print "<hr>\n";
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub err {
	local($msg) = "@_";
	&lsend("$msg\n");
	&send("<p><b>$msg</b>\n");
}

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

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub tuneident {
	local($addr,$date,$name);
	&dt;
	$name = $query->param('name');
	$addr = $query->param('addr');
	push @tune, "% Contributed $cymdhms by $name $addr" if ($name || $addr);
}