sub outtune {my $F = "outtune";
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Output one tune.  The tune must be in the global @tune array  and  all  its #
# titles  must be in the @ttl array.  We create a file whose name is based on #
# the first title, and then link it to names based on any other titles.  As a #
# special goodie, if the $Xname arg is true, we will link the tune to $X.abc, #
# where $X is the index number from the X:  line.                             #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($tdir,$overwrite,$Xname,$filnum) = @_;
	local($afil,$fils,@files,$line,$nfil,$pl,$Tfil,$ttl,$TTL);
	$fils = 0;
	if ($Xname) {
		mkdir 'T', 0775 unless -d 'T';
		mkdir 'X',0775 unless -d 'X';
		$tdir .= 'T/';
#	} else {
#		$tdir = "./" unless $tdir;
	}
#	$tdir =~ s"//+"/"g;
#	$tdir =~ s"^\./"";
	for $TTL (@ttl) {
		print "$F: TTL=\"$TTL\"<br>\n" if $V>2;
		next if ($TTL =~ /^\s*\(/);	# Ignore parenthesized pseudo-titles
		$ttl = &AdjTitle($TTL);		# Canonicalize the title
#		$ttl =~ s/'//g;				# Elide posessives and abbreviations
#		$ttl =~ s/^the\s+//i;		# Delete initial definite article
#		$ttl =~ s/^an?\s+//i;		# Delete initial indefinite article
#		$ttl =~ s/\b([a-z])/\u$1/g;	# Uppercase first letters
		$ttl =~ s/[^A-Za-z0-9]//g;	# Delete non-alphanum chars
		if ($ttl =~ /^\s*(\w+)\s*$/) {
			$ttl = $1;	# Untaint the title string
		} else {
			$ttl = '_unknown_';
		}
		$afil = &tunefilename("$tdir$ttl",$filnum,".abc",$overwrite) || '_yy_.abc';
		print "$F: File \"$afil\" ...<br>\n" if $V>2;
		if ($fils++ < 1) {
			if (open(T,">$afil")) {
				print T "X:1\n" unless defined $X;
				for $line (@tune) {
					chomp($line);
					print T "$line\n";
				}
				close T;
				print "\t$afil\n" if $V>1;
				push @files, $afil;
			} else {
				print STDERR "$0: Can't write \"$afil\" [$!]\n";
				return @files;
			}
			$Tfil = $afil;
		} else {
			Backup($afil) if -f $afil;
			link($Tfil,$afil);
		#	print "Link\t$Tfil -> $afil\n" if $V>2;
			print "\t$afil\n" if $V>1;
			push @files, $afil;
		}
	}
	if ($Xname) {
		if (!$N) {
			$N = $X;
			print "Using X=$X for N\n" if $V>1;
		}
		$nfil = &tunefilename(sprintf("X/%04d", $N),$filnum,".abc");
		if ($N) {
			link($Tfil,$nfil);
			print "Link\t$Tfil -> $nfil\n" if $V>2;
			++$fils;
		} else {
			print "####\t$Tfil not linked.\n" if $V>0 && $Xname;
		}
	}
	$pl = ($fils == 1) ? '' : 's';
	print "$F: Wrote tune to $fils file$pl.\n" if $V>2;
	&inittune();
	return @files;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Adjust the title. We do a bit of canonicalization, including converting all
# but the first letter of each word to lower case.
#
sub AdjTitle {
	local($t) = @_;
	$t =~ s/^\s+//;					# Strip initial white space
	$t =~ s/\s+$//;					# Strip trailing white space
	$t =~ s/\\\W*//;				# Strip out escaped accents
	$t =~ s/\s+/ /g;				# All white space to single space
	$t =~ s/^(the|a|an) //i;		# Strip initial articles
	$t =~ s/\b(\w)([\w']*)\b/\u$1\L$2/g;	# Ulll case all words except:
	$t =~ s/\bMc(\w)/Mc\u$1/ig;		# McPhuaiogh special case
	$t =~ s/\bO'(\w)/O'\u$1/ig;		# O'Bhaoirre special case
	$t =~ s"(\w)'s\b"$1's"ig;		# Bhaiesse's special case
	return $t;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Initialization for a new tune.  This  is  the  global  setup  used  in  the #
# abcsplit  program.   Other  programs may use this module, but you should be #
# careful of these global variables.                                          #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub inittune {
	@tune = ();
	$lines = 0;
	$T = undef;
	$N = undef;
	$X = undef;
	@ttl = ();
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This routine returns a name of a nonexistent file, based on the two strings #
# passed.   The  first  guess  is  "$pref$suff",  and  if that exists, we try #
# "$pref_$filnum$suff" for successive  values  of  $filnum.   If  a  non-null #
# $filnum  is passed to us, we use it, otherwise we add numbers starting at 1 #
# only if the file already exists.                                            #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub tunefilename {
	local($pref,$filnum,$suff,$overwrite) = @_;
	$pref = "_xx_" unless defined $pref;
	$suff = ".abc" unless defined $suff;
	$filnum = '' unless defined $filnum;
	$overwrite = 0 unless defined $overwrite;
	local($name) = "$pref$suff";
	$name = $pref . "_$filnum$suff" if (length($filnum) > 0);
	unless ($overwrite) {	# Search for unused file name
		while (-f $name) {	# If the file already exists,
			++$filnum;		# Incr the number and try again
			$name = "$pref" . "_" . "$filnum$suff";
		}
	}
	return $name;
}

1;