#!/usr/bin/perl -Tw
#
#NAME
#  TuneAdd - add ABC file to web archive
#
#SYNOPSIS
#  <form method=POST action=".../TuneAdd">
#
#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 ABCcontrib.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
if (-f "$host-cgilocal.pm") {
	require "$host-cgilocal.pm";
} else {
	require "cgilocal.pm";	# Where things are kept on this machine.
}
	require "Vopt.pm";
	require "DT.pm";
	require "Backup.pm";
	require "sendsubs.pm";
	require "outtune.pm";

#OPTIONS
#
#FILES
#
#  $abcdir/contrib/Title.abc
#    created for each T: title line.
#
#BUGS
#
#SEE ALSO
#
#  .../cgi/abc/ABCcontrib.html
#  .../cgi/abc/TuneGet
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu>
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

use strict;			# Paranoia.
no strict "vars";	# Allow global variables.

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

$| = 1;				# No output delays.
umask 0002;			# Output files must be group writable.
$mimetype = $htmltype = "text/html";
($me = $0) =~ s'.*/'' unless defined($me);
&Vopt($ENV{"V_$me"} || $ENV{"D_$me"} || $ENV{"T_$me"} || 1);
#$V = 4 if ($ENV{'REMOTE_ADDR'} eq '207.172.11.233');

$pathinfo = $ENV{'PATH_INFO'};
if (($pathdir,$pathrest) = ($pathinfo =~ m'^/([^/]+)/(.*)$')) {
} elsif (($pathdir) = ($pathinfo =~ m'^/([^/]+)/*$')) {
	$pathrest = '';
} else  {
	$pathdir = 'contrib';
	$pathrest = '';
}
#$title = $ABCttl{$pathdir} || 'ABC';
$subtitle = "Tune Entry";

$relpth  = $ABCdir{$pathdir};
$dirpth  = "$webdir/$relpth";
$dirurl  = "$usrurl/$relpth";
&send("dirpth=\"$dirpth\"<br>\n") if $V>2;
&send("dirurl=\"$dirurl\"<br>\n") if $V>2;

$entdir  = "$dirpth/Entry";	# Entry directory.
$adrdir  = "$dirpth/Addrs";	# Address directory.
&send("entdir=\"$entdir\"<br>\n") if $V>2;
&send("adrdir=\"$adrdir\"<br>\n") if $V>2;
$tmpdir  = "$dirpth/tmp";	# Temp directory.
&send("tmpdir=\"$tmpdir\"<br>\n") if $V>2;
$enturl  = "$dirurl/Entry";	# Entry URL.
$adrurl  = "$dirurl/Addrs";	# Address URL.
$tmpurl  = "$dirurl/tmp";	# Temp URL.
&send("enturl=\"$enturl\"<br>\n") if $V>2;
&send("adrurl=\"$adrurl\"<br>\n") if $V>2;
&send("tmpurl=\"$tmpurl\"<br>\n") if $V>2;

$name = $query->param('name') || 'tmp';
$emad = $query->param('emad') || 'anon';
$emfn = &emencode($emad);
&send("name=\"$name\"<br>\n") if $V>2;
&send("emad=\"$emad\"<br>\n") if $V>2;
&send("emfn=\"$emfn\"<br>\n") if $V>2;

$usrdir = "$entdir/$emfn";
$usrurl = "$enturl/$emfn";
&send("usrdir=\"$usrdir\"<br>\n") if $V>2;
&send("usrurl=\"$usrurl\"<br>\n") if $V>2;

unless (-d $usrdir) {
	mkdir($usrdir,0775)
		|| &send("<b>Can't mkdir \"$usrdir\" ($!)</b><br>\n") if $V>0;
}
chmod(0775,$usrdir);

$logpth = "$usrdir/$me.log";
$logurl = "$usrurl/$me.log";
if (open(L,">$logpth")) {
	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;
	print L "\tREMOTE_ADDR=$ENV{'REMOTE_ADDR'}\n" if $V>0;
} else {
	&err("Can't write \"$logpth\" ($!)");
	exit 1;
}
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");
	}
}
$host = $ENV{'HTTP_HOST'};
$ipad = $ENV{'REMOTE_ADDR'} || '0.0.0.0';
$adrfil = "$adrdir/$ipad";
$adrurl = "$adrurl/$ipad";
&lsend("host=\"$host\"\n") if $V>5;
&lsend("ipad=\"$ipad\"\n") if $V>5;
&lsend("adrfil=\"$adrfil\"<br>\n") if $V>2;
&lsend("adrurl=\"$adrurl\"<br>\n") if $V>2;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
&send("<br>Checking $dirpth$pathrest ...\n") if $V>1;
if (-f "$dirpth/$pathrest") {
	&send("<br>Load tune from $dirpth/$pathrest ...\n") if $V>1;
	if (open(T,"$dirpth/$pathrest")) {
		for $line (<T>) {
			if (!$X && $line =~ /^X:\s*(.*)\s+$/) {$X = $1; &send("<br>X=\"$X\"\n") if $V>1; next}
			if (!$R && $line =~ /^R:\s*(.*)\s+$/) {$R = $1; &send("<br>R=\"$R\"\n") if $V>1; next}
			if (!$T && $line =~ /^T:\s*(.*)\s+$/) {$T = $1; &send("<br>T=\"$T\"\n") if $V>1; next}
			if (!$C && $line =~ /^C:\s*(.*)\s+$/) {$C = $1; &send("<br>C=\"$C\"\n") if $V>1; next}
			if (!$M && $line =~ /^M:\s*(.*)\s+$/) {$M = $1; &send("<br>M=\"$M\"\n") if $V>1; next}
			if (!$L && $line =~ /^L:\s*(.*)\s+$/) {$L = $1; &send("<br>L=\"$L\"\n") if $V>1; next}
			if (!$Q && $line =~ /^Q:\s*(.*)\s+$/) {$Q = $1; &send("<br>Q=\"$Q\"\n") if $V>1; next}
			if (!$K && $line =~ /^K:\s*(.*)\s+$/) {$K = $1; &send("<br>K=\"$K\"\n") if $V>1; next}
			push @music, $line;
		}
		close T;
		$music = join('',@music) if @music;
	} else {
		&send("<br><B>Can't read \"$dirpth/$pathrest\" ($!)</B><br\n") if $V>1;
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
if ($retr = $query->param('RETR')) {
	&send("<br>Retrieving tune ...\n") if $V>1;
	&retrieve();
	exit 0;
}

$Action = $query->param('Action');
if ($Action eq 'Show') {
	&lsend("Action=$Action\n") if $V>1;
	$cmd = "w3cat +H http://localhost/~jc/cgi/abc/TuneList$usrurl/";
	&lsend("cmd=$cmd\n") if $V>1;
	&send("Tune List for $emad ($emfn)<br>\n");
	system $cmd;
	&lsend("Exit $?\n") if $V>1;
	exit $?;
}
if ($text = $query->param('text')) {
	@text = split /[\r\n]+/, $text;
}
$data = $query->param('data');
&lsend("data=\"$data\"\n") if $V>1;
unless (@data = split(/\n/,$data)) {
	&lsend("No data submitted for ABC tune\n") if $V>1;
	if (open(F,$adrfil)) {
		for $line (<F>) {
			&lsend("F: $line") if $V>1;
			if ($line =~ /^([\d.]+)\t(.+)\t(.+)\s*$/) {
				$emfn = $2;
				$name = $3;
				$emad = &emdecode($emfn);
				&lsend("emfn=\"$emfn\" $emad=\"$emad\" name=\"$name\"\n") if $V>1;
			}
		}
		close F;
	}
	$docfil = "$dirpth/Add.html";
	&lsend("docfil=\"$docfil\"\n") if $V>2;
	unless (open(DOC,$docfil)) {
		&lsend("Can't read \"$docfil\" ($!)\n");
		&send("<br><b>Can't read \"$docfil\" ($!)</b><br>\n") if $V>0;
		exit 1;
	}
	$title = $subtitle = '';
	for $line (<DOC>) {
		$line =~ s/<#([^#>]*)#>/eval($1)/eg;
		&send($line);
	}
	exit 0;
}
%mimetype = (
	'ABC'  => 'text/vnd.abc',
	'EPS'  => 'application/postscript',
	'GIF'  => 'text/html',
	'HTML' => 'text/html',
	'MIDI' => 'audio/midi',
	'PNG'  => 'text/html',
	'PS'   => 'application/postscript',
);
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.                                                 #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
%Hmap = (
	'B:Ryan' => "Ryan's Mammoth Collection of Fiddle Tunes",
	'B:Cole' => "Cole's 1000 Fiddle Tunes",
);
for $H ('X','T','P','C','O','S','B','Z','R','M','L','Q') {
	if ($h = $query->param($H)) {
		&lsend("$H: \"$h\"\n") if $V>2;
		$h =~ s"^\s*(.*)\s*$"\1";
		&lsend("$H: \"$h\"\n") if $V>1;
		if ($x = $Hmap{"$H:$h"}) {$h = $x}
		$X = $h = int($h) if ($H eq 'X');
		$R = $h =  lc($h) if ($H eq 'R');
		push @hdrs, "$H: $h";
	} else {
		&lsend("$H missing.\n") if $V>1;
	}
}
if ($T = $query->param('T')) {	# Fetch the title again,
	&send("<br>T=\"$T\"<br>\n") if $V>2;
	$T = &AdjTitle($T);			# and canonicalize it.
	push @ttl, $T;
	push @title, $T;
}
if (!$R) {
	&lsend("R: unknown.\n") if $V>1;
	if ($T =~ /.*\s+--\s+([\w\s]+)/) {
		$R = lc($1);
		$R =~ s/\s+$//;
		&lsend("R: $R.\n") if $V>1;
	}
}
$chk = $query->param('CHK');

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# ABC requires that a tune start with the X: line, so wee grab the X: #
# line from @hdrs or @data, whichever has one, and force it to be the #
# first line of @tune, where we build the tune.                       #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
if ($hdrs[0] =~ /^X:/) {	# Was there an X: in the headers?
	push @tune, shift(@hdrs);
}
if ($data[0] =~ m"^X:\s*([\d/.]+)") {	# Does the data start with X:?
	$line = shift(@data);	# Strip it from data.
	unless ($X) {			# Ignore if X already defined.
		($X = $1) =~ s/[\r\s]+$//;
		push @tune, $line;
	}
}

push @tune, @hdrs;	# Copy remaining headers to tune.

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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) {
	$line =~ s/[\r\s]+$//;
	&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();
				$Khdr = $2;		# Remember the key.
			} elsif ($H eq 'X') {
				$X = $A;		# Note the index number.
				&lsend("X=\"$X\"") if $V>1;
			} 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("---: Khdr=\"$Khdr\"\n") if $V>2;
			$hdr = 0;			# Now in music phase.
			&tuneident();
			unless ($Khdr) {		# Make sure there's a key.
				$Khdr = $query->param('K') || 'C';
				&lsend("Key: \"$Khdr\"\n") if $V>2;
				push @tune, "K: $Khdr";
			}
		}
	} else {
		&lsend("ABC: \"$line\"\n") if $V>2;
	}
	push @tune, $line;		# Send every line to file.
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
if ($chk) {
	$st = &checktune();
	exit $st;
}

&lsend("X=\"$X\" at end of tune.\n") if $V>1;
unless ($X) {
	$X = '01';
	unshift @tune, "X:$X";
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# If an output format was requested, we write the tune to a temp file #
# and invoke a conversion program. If the verbose level is 2 or less, #
# we will have produced no output yet, so  the  conversion  program's #
# output is what the client will receive.                             #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
if ($fmt = ($query->param('PS') || $query->param('GIF') || $query->param('MIDI'))) {
	&lsend("Request for $fmt output.\n");
	$abcfile = "$usrdir/$me.abc";
	&lsend("Create ABC file \"$abcfile\"\n");
	unless (open(ABC,">$abcfile")) {
		&err("Can't write \"$abcfile\" ($!)");
		exit 1;
	}
	for $line (@tune) {
		$line =~ s"[\r\n\t\s]+$"";	# Trim ^M and other whitespace
		print ABC "$line\n";
	}
	close ABC;
	$url = "http://$host$cgiurl/TuneGet?F=$fmt&S=0.70&n=1&c=0&ndx=0&U=http://$host$usrurl/$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 $?;
}

&send("<br>Your contribution has been put into the directory\n") if $V>0;
&send("<a href=\"$usrurl/\">$usrurl/</a>.<br>\n") if $V>0;

@files = &outtune("$usrdir/",1);
if (@files) {
	$T = '';
	$n = int(@files);
	$pl = ($n == 1) ? '' : 's';
	&send("<br><b>ABC tune file$pl created:</b><br><bl>\n");
	for ($i = 0; $i < $n; $i++) {
		$file = $href = $link = $files[$i];
		$titl = $title[$i];
		$href =~ s"$usrdir"$usrurl";
		($T = $href) =~ s".*/(\w+)\.abc"$1" unless $T;
		&send("<li><a href=\"$href\">$titl</a>\n");
		$link =~ s"/Entry/.*/"/Tunes/";	# Path for link to Tunes/ directory
		$href =~ s"/Entry/.*/"/Tunes/";	# URL  for link to Tunes/ directory
		if (-f $link) {						# Don't wipe out existing file
			if (&notsame($file,$link)) {	# Are they the same file?
				Backup($link);				# If not, back up old Tunes/ file
				&send("<li><a href=\"$href-\">$titl</a> (backed up)\n");
				if (link($file,$link)) {	# Link new file into Tunes/
					$link =~ s"$dirpth"$dirurl";
					&send("<li><a href=\"$href\">$titl</a> (linked)\n");
				} else {
					&send("<br><b>Can't link \"$file\" to \"$link\" ($!)</b><br>\n") if $V>0;
				}
			} else {					# Tunes/ link already exists
				&send("<li><a href=\"$href\">$titl</a> (is link)\n");
			}
		} elsif (link($file,$link)) {		# Create link into Tunes/ directory
			$link =~ s"$dirpth"$dirurl";	# File now has both names
			&send("<li><a href=\"$href\">$titl</a> (linked)\n");
		} else {
			&send("<br><b>Can't link \"$file\" to \"$link\" ($!)</b><br>\n") if $V>0;
		}
	}
	&send("</ol>\n");
} else {
	&lsend("No titles found.\n") if $V>0;
}

	&send("<p>\n");
	&send("Return tune in various formats:<br>\n");
	$hscr = "$cgiurl/TuneGet";
	&lsend("hscr=\"$hscr\"\n") if $V>3;
	$Xopt = 1;
	&send("<table border=3 cellpadding=3 cellspacing=3><tr>\n");
	&send("<td><a href=\"$href\">File</a></td>\n");
	&send("<td><a href=\"$hscr?F=ABC&X=$Xopt&n=1&copt=0&U=$href&N=/$T.abc\">ABC</a></td>\n");
	&send("<td><a href=\"$hscr?F=TXT&X=$Xopt&n=1&copt=0&U=$href&N=/$T.txt\">TXT</a></td>\n");
	&send("<td><a href=\"$hscr?F=PS&X=$Xopt&n=1&copt=0&U=$href&N=/$T.ps\">PS</a></td>\n");
	&send("<td><a href=\"$hscr?F=EPS&X=$Xopt&n=1&copt=0&U=$href&N=/$T.eps\">EPS</a></td>\n");
	&send("<td><a href=\"$hscr?F=PDF&X=$Xopt&n=1&copt=0&U=$href&N=/$T.eps\">PDF</a></td>\n");
	&send("<td><a href=\"$hscr?F=GIF&X=$Xopt&n=1&copt=0&U=$href&N=/$T.gif\">GIF</a></td>\n");
	&send("<td><a href=\"$hscr?F=PNG&X=$Xopt&n=1&copt=0&U=$href&N=/$T.png\">PNG</a></td>\n");
	&send("<td><a href=\"$hscr?F=MIDI&X=$Xopt&n=1&copt=0&U=$href&N=/$T.midi\">MIDI</a></td>\n");
	&send("</tr></table>\n");

&send("<p>\n");
&send("You can also get a\n");
&send("\t<a href=\"$usrurl/\">plain</a> or\n");
&send("\t<a href=\"/~jc/cgi/abc/TuneList$usrurl/\">ABC</a>\n");
&send("listing of your files.\n");

if (open(ADR,">$adrfil")) {
	&send("<br>Write \"$adrfil\"<br>\n") if $V>2;
	print ADR "$ipad\t$emfn\t$name\n";
	close ADR;
} else {
	&send("<br><b>Can't write \"$adrfil\" ($!)</b><br>\n") if $V>0;
}

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

exit 0;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub checktune {
	local($arg,$errors,$hdr,$line,$warnings);
	local($Lhdr,$Mhdr,$Qhdr,$Thdr,$Xhdr);
	$errors = $warnings = 0;
	&send("<br><center>Syntax check for ABC tune</center><hr>\n");
	for $line (@tune) {
		$line =~ s/[\r\n\t\s]+$//;
		&send("<tt>\n");
		&send(&htmlencode($line));
		&send("</tt><br>\n");
		if (($hdr,$arg) = ($line =~ /^([A-Za-z]):\s*(.*)$/)) {
			if ($hdr eq 'X') {
				$Xhdr = $arg;
			} elsif ($hdr eq 'K') {
				$Khdr = $arg;
				&send("<b>...K: \"$Khdr\"</b><br>\n") if $V>4;
			} elsif ($hdr eq 'L') {
				$Lhdr = $arg;
				&send("<b>...L: \"$Lhdr\"</b><br>\n") if $V>4;
			} elsif ($hdr eq 'M') {
				if ($Lhdr && !$Mhdr) {
					++$warnings;
					&send("<b>--- M: may override earlier L: line</b> (M: should be first)<br>\n");
				}
				$Mhdr = $arg;
				&send("<b>...M: \"$Mhdr\"</b><br>\n") if $V>4;
			} elsif ($hdr eq 'Q') {
				$Qhdr = $arg;
				&send("<b>...Q: \"$Qhdr\"</b><br>\n") if $V>4;
			} elsif ($hdr eq 'T') {
				$Thdr = $arg;
				&send("<b>...T: \"$Thdr\"</b><br>\n") if $V>4;
			} else {
				&send("<b>--- $hdr: unrecognized header.</b><br>\n") if $V>4;
			}
		} else {
			 &send("--- (body)<br>\n") if $V>5;
		}
	}
	&send("<hr>\n");
	unless (defined($Khdr)) {
		++$errors;
		&err("+++ K: No key specified.\n");
	}
	unless (defined($Xhdr)) {
		++$warnings;
		&err("--- X: index missing.\n");
		unless (defined($Thdr)) {
			&err("+++ T: title also missing.\n");
			++$errors;
		}
	}
	&send("<p>Serious errors: $errors.<br>Minor problems: $warnings.<br>\n");
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Email-address decoder.  This should be an inverse of emencode(),  returning
# a usable email address.
sub emdecode {
	local($addr) = @_;
	$addr =~ s/:/%/g;
	$addr =~ s/^(.+)%/$1@/;
	return $addr;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Email-address encoder. We convert an email address to something usable as a
# directory  name without causing problems with shells.  Another motive is to
# transform the address into something that spam software is unlikely to spot
# and use.
sub emencode {
	local($addr) = @_;
	$addr =~ s/^[\s<#]*//;
	$addr =~ s/[\s#>]*$//;
	$addr =~ s/[@%]/:/g;
	return $addr;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub htmlencode {
	local($s) = @_;
	$s =~ s'<'&lt;'g;
	$s =~ s'>'&gt;'g;
	$s;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub htmlhdr {
	print "Content-type: $mimetype\n\n";
	if ($mimetype eq $htmltype && $title) {
		print "<html>\n";
		print "<head>\n";
		print "<title>$title - $subtitle</title>\n";
		print "</head>\n";
		print "<body>\n";
		print "<center>\n";
		print "\t<b>$title - $subtitle</b>\n";
		print "<br>Log file: <a href=\"$logurl\">$logurl</a>\n";
		print "</center>\n";
		print "<hr>\n";
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Return true if the file names refer to the same (linked) file.
# ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)
#	= stat($filename);
sub notsame {
	local($file1,$file2) = @_;
	local(@stat1) = stat($file1);
	local(@stat2) = stat($file2);
	return (($stat1[0] != $stat2[0]) || ($stat1[1] != $stat2[1]));
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub retrieve {
	local(@files);
	if ($R = $query->param('R')) {
		&send("<br>Rhythm: \"$R\"\n") if $V>1;
	}
	if ($T = $query->param('T')) {
		&send("<br>Title: \"$T\"\n") if $V>1;
	}
	if ($C = $query->param('C')) {
		&send("<br>Composer: \"$C\"\n") if $V>1;
	}
	if ($usrdir && -d $usrdir) {
		&send("<br>List $usrdir ...\n") if $V>1;
		@files = glob("$usrdir/[A-Z]*.abc");
	}
	&send("<br>List $dirpth ...\n") if $V>1;
	push @files, glob("$dirpth/Tunes/[A-Z]*.abc");
	$n = int(@files);
	&send("<br>There are $n files that match.") if $V>0;
file:
	for $file (@files) {
		&send("<br>Testing \"$file\" ...\n") if $V>3;
		unless (open(F,$file)) {
			&send("<br><B>Can't read \"$file\" ($!)\n") if $V>0;
			next;
		}
		for (<F>) {
			if (/^T: .*$T/) {push @tunes, $file; next file}
			if (/^R: .*$R/) {push @tunes, $file; next file}
			if (/^C: .*$C/) {push @tunes, $file; next file}
		}
		&send("no.\n") if $V>3;
	}
	close F;
	for $tune (@tunes) {
		if ($tune =~ s"$usrdir/"") {
			&send("<br><a href=\"$cgiurl/TuneAdd/ryan-cole/Entry/$emfn/$tune\">Entry/$emfn/$tune</a>");
		} elsif ($tune =~ s"$dirpth/"") {
			&send("<br><a href=\"$cgiurl/TuneAdd/ryan-cole/$tune\">$tune</a>");
		}
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub send {
	unless ($hdrDone) {&htmlhdr(); $hdrDone++}
	print @_;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub tunetext {
	local($l);
	push @tune, "N:\n";
	for $l (@text) {
		$l =~ s/\s+$//;
		&lsend("N: $l\n") if $V>1;
		push @tune, "N: $l\n";
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub tuneident {
	local($emad,$emfn,$idnt,$name);
	&dt;
	$name = $query->param('name');
	$emad = $query->param('emad');
	$emfn = &emencode($emad);
	$idnt = "Z: Contributed $cymdhms by $name $emad\n";
	&lsend($idnt) if $V>1;
	push(@tune,$idnt) if ($name || $emad || $emfn);
	&tunetext() if @text;
}