#!/usr/bin/perl
#
#NAME
#  abcsplit - extract ABC tunes from files.
#
#SYNOPSIS
#  abcsplit [file | URL] ..
#
#DESCRIPTION
#  This program reads thru its input, looking for ABC music.  When it
#  finds  a chunk of music, it creates a file derived from the title,
#  and writes the music to the file.
#
#  Input is from STDIN if there are no command-line URLs or files. If
#  there  are things named on the command line, we will first attempt
#  to open them as local files, and if that fails,  we  then  try  to
#  open them as URLs.  At present, only http:// URLs work.
#
#  If there is already a file by the given name, we  add  '_'  and  a
#  number to the name.
#
#  We recognize a tune when we encounter an X: or a T: line.  We will
#  generate an X:0 line for tunes that lacked an X: line. A tune ends
#  with the first blank line (and a line that contains spaces  and/or
#  tabs is considered a blank line).
#
#REQUIRES
#  The following modules are needed for web access.  They should be in
#  the same place that you found this script.
#
	push @INC,"$ENV{HOME}/lib","$ENV{HOME}/sh",'sh';
	require "URLopen.pm";	#Parses URL and returns file handle.
	require "HTTPcon.pm";	#Makes HTTP connection, sends GET.
	require "HTMLdir.pm";	#Produces HTML listing of directory.
#
#OPTIONS
#  Options are args that start with '-' or '+', which disable or enable
#  some feature, respectively.  The options are:
#
#  +N
#      Number the output files.
#
#  +O  Overwrite existing files.
#      If there are two tunes with the same title,  the  second  will
#      wipe out the first.
#  -O  Don't overwrite existing files (default).
#      Instead, '_' and a number are added to the tune  name,  and  a
#      new file named for the tune is created.
#
#  +X  Generate X.abc files, where X is the tune's index number.  The
#      X.abc file will be a link to the file named for the title.
#  -X  Don't generate the X.abc files (default).
#
#  For the O'Neill's project files, where the tunes have the number
#  from the book, commands like this are used:
#      abcsplit +ox ../files/1176-1275B.abc
#  Then the Title.abc and X.abc files are moved to another directory.
#
#SEE ALSO
#  abcjoin
#
#BUGS
#  Each time this is run, an  entirely  new  set  of  files  will  be
#  created.   Maybe we should compare each tune to the existing file,
#  and if they are identical, not write anything.  But that's  for  a
#  future release.
#
#  ABC embedded in HTML files will probably not work sensibly.
#
#  We extract only the usascii letters [A-Za-z] to generate the  file
#  name.  Perhaps we should also recognize the Latin-1 letters.  Some
#  day we'll all convert to Unicode and this won't matter.
#
#  I wonder if there are any ABC tools that can't handle  X:0  lines.
#  The  Arabs  taught  us about zero many centuries ago, but it seems
#  that some programmers still haven't caught on to the concept.
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu>
#  You may use this program freely for any purposes, as long  as  you
#  give me credit for it (and take credit for any changes you make).

$| = 1;
($me = $0) =~ s'.*/'';
$V = $ ENV{"V_$me"} || 1;
$overwrite = 0;		# If true, overwrite existing files.
&inittune;
$renumber = 0;		# If true, append number to output file names.

arg:
for $f (@ARGV) {
	print STDERR "$me: Arg \"$f\"\n" if $V>2;
	if (($flg,$opts) = ($f =~ /^([-+])(.*)$/)) {
		while ($opts =~ s/(.)//) {
			$opt = lc($1);
			print "$me: Opt '$opt'\n" if $V>2;
			if ($opt eq 'n') {		# Renumber output files.
				$renumber = ($flg eq '+' ? 1 : 0);
				print "$me: renumber=$renumber.\n" if $V>1;
			} elsif ($opt eq 'o') {		# Overwrite existing files.
				$overwrite = ($flg eq '+' ? 1 : 0);
				print "$me: overwrite=$overwrite.\n" if $V>1;
			} elsif ($opt eq 'x') {	# Kludge for producing numbered files.
				$Xname = ($flg eq '+' ? 1 : 0);
				print "$me: Linking to X-index names.\n" if $V>1;
			} else {
				print STDERR "$me: Unknown option $flg$opt ignored.\n" if $V>0;
			}
		}
		next arg;
	} elsif (open(FIL,$f)) {
		&onefile('FIL');
	} elsif (&URLopen(*URL,$f)) {
		&onefile('URL');
	}
	&outtune if $lines > 1;
	++$files;
}
unless ($files) {
	print "$me: Reading STDIN.\n" if $V>1;
	&onefile('STDIN');
	++$files;
}
&outtune if $lines > 1;
print "$me: $files tune" . ($files==1)?'':'s' . " read.\n" if $V>1;
exit 0;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Initialization for a new tune.
sub inittune {
	@tune = ();
	$lines = 0;
	$T = '';
	$X = 0;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Extract the tunes from one open file. We are passed the name of the
# file handle.
sub onefile {
	local($f) = @_;
	for $l (<$f>) {
		chomp $l;
		if (!$l) {
			print "Got blank line.\n" if $V>1;
			&outtune if $lines > 1;
			next;
		}
		print "Line $l\n" if $V>3;
		if ($l =~ /^X:\s*(\d+)/) {
			print "Got X: $1.\n" if $V>1;
			$X = $1;
			&outtune if $lines > 1;
			$tune[$lines++] = "$l\n";
			next;
		}
		if ($l =~ /^T:\s*(.*)/) {
			print "Got T: \"$1\"\n" if $V>1;
			if (!$T) {
				$T = $1;
				$T =~ s/'//g;				# Elide posessives and abbreviations.
				$T =~ s/^the\s+//i;			# Delete initial definite article.
				$T =~ s/^an?\s+//i;			# Delete initial indefinite article.
				$T =~ s/\b([a-z])/\u$1/g;	# Uppercase first letters.
				$T =~ s/[^A-Za-z0-9]//g;	# Delete non-alphanum chars.
			}
			$tune[$lines++] = "$l\n";
			next;
		}
		if ($lines > 0) {
			print "Line $lines is \"$l\"\n" if $V>1;
			$tune[$lines++] = "$l\n";
		}
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Output one tune.
sub outtune {
	local($tfil) = "$T.abc";
	local($xfil) = "$X.abc";
	local($i);
	if ($renumber) {
		$i = 1;
		$tfil = $T . '_' . $i . '.abc';
		$xfil = $X . '_' . $i . '.abc';
	}
	unless ($overwrite) {
		while (-f $tfil) {
			print STDERR "Tune \"$tfil\" exists already.\n" if $V>0;
			$i ++;
			$tfil = $T . '_' . $i . '.abc';
		}
#		$i = 0;
		while (-f $xfil) {
			print STDERR "Tune \"$xfil\" exists already.\n" if $V>0;
			$i ++;
			$xfil = $X . '_' . $i . '.abc';
		}
	}
	if ($i > 0) {
		$tfil = $T . '_' . $i . '.abc';
		$xfil = $X . '_' . $i . '.abc';
	}
	print "Tune \"$tfil\" $Xname $X \"$xfil\"\n" if $V>3;
	if (open(T,">$tfil")) {
		print T "X:0\n" if !$X;
		print T @tune;
		close T;
		print "Tune \"$tfil\"\n" if $V>0;
		if ($Xname && ($X>0)) {
			print "Link \"$tfil\" -> \"$xfil\" ...\n" if $V>3;
			unlink($xfil) if -f $xfil;
			if (link($tfil,$xfil)) {
				print "Link \"$tfil\" -> \"$xfil\"\n" if $V>0;
			} else {
				print STDERR "$0: Can't link \"$tfil\" to \"$xfil\" [$!]\n";
			}
		}
	} else {
		print STDERR "$0: Can't write \"$tfil\" [$!]\n";
	}
	&inittune;
}