# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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.                             #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub outtune {
	local($tdir,$overwrite,$Xname,$filnum) = @_;
	local($afil,$fils,@files,$line,$nfil,$pl,$Tfil,$ttl,$TTL);
	local($F) = "$me/outtune";
	$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\"\n" if $V>2;
		next if ($TTL =~ /^\s*\(/);	# Ignore parenthesized pseudo-titles
		$ttl = &title2name($TTL);	# Generate the file basename
		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>2;
		}
		$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;
}

sub title2name { my $F='title2name';
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Generate a file basename from a title.  We have several ways of doing this, #
# depending on the $namestyle global variable.                                #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($ttl) = @_;
	$ttl = &AdjTitle($ttl);	# Canonicalize the title
#	$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
	print "$F: Title is '$ttl'\n" if $V>2;
	if ($namestyle eq '_') {	# Style '_'
		print "$F: Style _\n" if $V>2;
		$ttl =~ s/'+//g;		# Elide posessives and abbreviations
		print "$F: Title -> '$ttl'\n" if $V>2;
		$ttl =~ s/[^A-Za-z0-9]+/_/g;	# Convert non-alphanum strings to '_'
		print "$F: Title -> '$ttl'\n" if $V>2;
	} elsif ($namestyle eq 'C') {	# Style 'C' is init caps
		print "$F: Style C\n" if $V>2;
		$ttl =~ s/\b(\w)([\w']*)\b/\u$1\L$2/g;	# Ulll case all words except:
		print "$F: Title -> '$ttl'\n" if $V>2;
		$ttl =~ s/\b(Ma*c)(\w)/$1\u$2/ig;		# McPhuaiogh special case
		print "$F: Title -> '$ttl'\n" if $V>2;
		$ttl =~ s/\bO'(\w)/O'\u$1/ig;			# O'Bhaoirre special case
		print "$F: Title -> '$ttl'\n" if $V>2;
		$ttl =~ s"(\w)'s\b"$1's"ig;			# Bhaiesse's special case
		print "$F: Title -> '$ttl'\n" if $V>2;
		$ttl =~ s/[^A-Za-z0-9]//g;			# Delete non-alphanum chars
		print "$F: Title -> '$ttl'\n" if $V>2;
	} else {
		print "$F: Style '$namestyle' unknown.\n" if $V>2;
		$ttl =~ s/[\s$namestyle]+/$namestyle/g;	# Unknown style; replace spaces with style char
		$ttl =~ s/[^A-Za-z0-9$namestyle]//g;	# Delete all other non-alphanum chars
		print "$F: Title -> '$ttl'\n" if $V>2;
	}
	$afil = &tunefilename("$tdir$ttl",$filnum,".abc",$overwrite);
	print "$F: File \"$afil\" ...\n" if $V>2;
	return $afil;
}

sub AdjTitle {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Adjust the title. We do a bit of canonicalization, including converting all
# but the first letter of each word to lower case.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	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
	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) = @_;
	local($name) = "$pref$suff";
	$name = $pref . "_$filnum$suff" if (length($filnum) > 0);
	$name =~ s/__+/_/g;		# Don't repeat '_'
	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";
			$name =~ s/__+/_/g;		# Don't repeat '_'
		}
	}
	return $name;
}

1;