#!/usr/bin/perl # # NAME # TuneFind # # SYNOPSIS #
# # DESCRIPTION # This is the tune-finder CGI script invoked by FindTune.html, and # should be installed in your web server's "/cgi/abc/" directory. # # We expect GET or POST params giving a title or pattern, and we # search the ABCbot's tune index files for matching entries. We # produce a HTML listing of the matches, formatted to deliver # either the original file, or invoke the Tune script to extract a # tune and format it. # # REQUIRES require "cgilocal.pm"; # Where things are kept on this machine. # AUTHOR # John Chambers # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # $| = 1; # Unbuffered STDOUT. $V = 2; # Verbose level. $" = ','; # Used in verbose messages. ($me = $0) =~ s".*/""; $exitstat = 0; # Exit code, set to nonzero if serious problem. $oneills = 1; # Enable O'Neill Project kludge/heuristic. $GBmax = 16 unless $GBmax; # Max length of GBcode. $JCmax = 15 unless $JCmax; # Max length of JCcode. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Here are some translation tables to produce HTML encoded chars: %Huml = ( 'A' => 'Ä', 'a' => 'ä', 'E' => 'Ë', 'e' => 'ë', 'I' => 'Ï', 'i' => 'ï', 'O' => 'Ö', 'o' => 'ö', 'U' => 'Ü', 'u' => 'ü', ); %Hacu = ( 'A' => 'Á', 'a' => 'á', 'E' => 'É', 'e' => 'é', 'I' => 'Í', 'i' => 'í', 'O' => 'Ó', 'o' => 'ó', 'U' => 'Ú', 'u' => 'ú', ); %Hgra = ( 'A' => 'À', 'a' => 'à', 'E' => 'È', 'e' => 'è', 'I' => 'Ì', 'i' => 'ì', 'O' => 'Ò', 'o' => 'ò', 'U' => 'Ù', 'u' => 'ù', ); %Hcir = ( 'A' => 'Â', 'a' => 'â', 'E' => 'Ê', 'e' => 'ê', 'I' => 'Î', 'i' => 'î', 'O' => 'Ô', 'o' => 'ô', 'U' => 'Û', 'u' => 'û', ); %Hrin = ( 'A' => 'Å', 'a' => 'å', ); %Hsla = ( 'C' => 'Ç', 'c' => 'ç', 'O' => 'Ø', 'o' => 'ø', ); # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # $dir = ($me eq 'FindTest') ? 'Ndx' : 'Index'; #&send("Content-type: text/html\n\n"); $cgi = new CGI_Lite; &send("JC's ABC tune match\n"); $logfile = "$tmpdir/Find$$.log"; if (!open(L,">>$logfile")) { &send("Can't write \"$logfile\" ($!)\n"); &quit(1); } select L; $| = 1; select STDOUT; $Lopen = 1; # Logfile is open. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # %data = $cgi->parse_form_data (); chomp($cwd = `pwd`); $data{ndxdir} = $ndxdir; $codes = $data{codes}; $pat = $data{P} || $data{pattern}; $pat =~ s/^\s+(.*?)\s*$/$1/; # Trim initial white space. $pat =~ s/\s\s+/ /; # Reduce internal white space. $RA = $ENV{REMOTE_ADDR} || '0.0.0.0'; $V = 3 if $RA =~ /^132\.197\./; ($ss,$mm,$hh,$DD,$MM,$YY) = gmtime(time); $idlines = sprintf("P: $pat\nH: %d-%02d-%02d %02d:%02d:%02d UT\n",1900+$YY,1+$MM,$DD,$hh,$mm,$ss); if ($V>1) { &lsend("From: $RA\n$idlines"); &lsend("Data:\n"); for $x (sort keys %data) {$y = $data{$x}; &lsend("\t$x\t$y\n")} } if ($V>2) { &lsend("Environment:\n"); for $x (sort keys %ENV) {$y = $ENV{$x}; &lsend("\t$x\t$y\n")} } print "Looking for \"$pat\".
\n" if ($V>0 && $pat); &send("
\n"); &send("
File
retrieves entire file.\n"); &send("
ABC
retrieves selected ABC tune.\n"); &send("
PS
returns tune in PostScript format.\n"); &send("
EPS
returns tune in Encapsulated PostScript format.\n"); &send("
GIF
returns tune in Graphics Interchange Format.\n"); &send("
MIDI
returns tune in Musical Instrument Digital Interfact format.\n"); &send("
\n"); #send("(Codes $codes)\n"); if ($codes eq 'on') { &send("(The big numbers are some experimental musical codes.)\n"); } else { &send("\n"); } &send("
\n"); &send("
\n");

chdir $ndxdir;
chomp($cwd = `pwd`);
&lsend("Changed to $cwd\n") if $V>1; 
@files = glob('??.html'); 

file:
for $file (@files) {
	if (!open(F,$file)) {
		&send("File: \"$file\" Can't read ($!) \n");
		next file;
	}
	&lsend("file: $file\n") if $V>2;
line:
	for $line () {
		if ($pat && ($line =~ /$pat/i)) {
			&matched($line);
		} else {
			&lsend("-: $line") if $V>4;
		}
	}
}

if (@match) {
	$matches = @match;
	&send("
\n"); &send("\n$matches matches.\n"); &lsend("$matches matches.\n") if $V>1; &send("
* O'Neill's Project tunes, not yet released to the public.\n") if $gotONeills; } else { &send("No matches.\n"); &lsend("No matches.\n") if $V>1; } &send("
\n"); &send("Send comments, bug reports, and other suggestions to\n"); &send(" John Chambers at MIT.\n"); &lsend("Exit $exitstat.\n") if $V>1; &send("
\n"); exit $exitstat; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Convert all the escape sequences in an ABC string to their HTML encodings. # This is only done to title strings at present. sub abc2html { local($s) = @_; $s =~ s#(\\)([\#'`^])([aeiou])#&htmlenc($1,$2,$3)#eg; # Marked vowels. $s =~ s#(\\)([co])#&htmlenc($1,'/',$3)#eg; # C-cedille and o-slash. $s =~ s#(\\)(a)(a)#&htmlenc($1,$2,$3)#eg; # Scand \aa notation. $s =~ s#([aeiou])/#&htmlenc('',"'",$1)#ieg; # Gaelic V/ notation. return $s; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Convert one escape sequence to its corresponging HTML encoding. If we can't # identify it, we return the original string. sub htmlenc { local( $c1, # Escape char, used only when we fail. $c2, # The mark char, used to select a translate table. $c3) # The char to mark, used to select a table entry.. = @_; return($Huml{$c3} || "$c1$c2$c3") if ($c2 eq '"'); return($Hacu{$c3} || "$c1$c2$c3") if ($c2 eq "'"); return($Hgra{$c3} || "$c1$c2$c3") if ($c2 eq '`'); return($Hcir{$c3} || "$c1$c2$c3") if ($c2 eq '^'); return($Hrin{$c3} || "$c1$c2$c3") if ($c2 eq 'a'); return($Hsla{$c3} || "$c1$c2$c3") if ($c2 eq '/'); return("$c1$c2$c3"); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Send a line to the logfile. sub lsend { print L @_ if $Lopen; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Given all the info for one match, this routine sends the info to the client # as a single line in a consistent format. The line starts with a series of # links that retrieve the tune in various formats. These links are followed # with info about the tune, which we may vary from time to time.. sub msend { local($url,$ndx,$GBcode,$JCcode,$key,$ttl) = @_; local($nam,$X,$K); $nam = &name($url,$ttl); $ttl = &abc2html($ttl); &send("$flFile "); &send("ABC "); &send("PS "); &send("EPS "); &send("GIF "); &send("MIDI "); $X = sprintf("%5d",$ndx); $K = substr("$key ",0,8); if ($codes eq 'on') { $GBcode = substr(($GBcode . ('_' x $GBmax)),0,$GBmax) if length($GBcode) > $GBmax; $JCcode = substr(($JCcode . ('_' x $JCmax)),0,$JCmax) if length($JCcode) > $JCmax; &send("$X $GBcode $JCcode $K $ttl\n"); } else { &send("$X $K $ttl\n"); } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # This routine is called when we find an acceptable line. We break it apart # into its fields, and generate a single line of HTML that is sent to the # client. sub matched { chomp(local($line) = @_); local($K,$key,$ndx,$T,$ttl,$url,$X); push @match, $line; &lsend($line) if $V>3; $fl = ' '; if (index($line,'/book/oneills/') >= 0) { # Special kludge/heuristic for O'Neill's Project. $fl = '*'; ++$gotONeills; } if (($url,$ndx,$c1,$c2,$key,$ttl) = ($line =~ m'abc\s*_*(\d+)\s(\d+)\s(\d+)\s(\w+.*)\s*(.*)'i)) { &lsend("M1: U=\"$url\" X=\"$ndx\" K=\"$key\" T=\"$ttl\"\n") if $V>2; &msend($url,$ndx,$c1,$c2,$key,$ttl); } elsif (($url,$ndx,$key,$ttl) = ($line =~ m'abc\s*_*(\d+)\s+(\w+.*)\s*(.*)'i)) { &lsend("M1: U=\"$url\" X=\"$ndx\" K=\"$key\" T=\"$ttl\"\n") if $V>2; &msend($url,$ndx,'','',$key,$ttl); } elsif (($url,$ndx,$ttl) = ($line =~ m'abc\s*_*(\d+)\s.*(.*)'i)) { &lsend("M2: U=\"$url\" X=\"$ndx\" T=\"$ttl\"\n") if $V>2; &msend($url,$ndx,'','',$key,$ttl); } elsif (($url,$ndx,$ttl) = ($line =~ m'File.*\s+_*(\d+)\s.*(.*)'i)) { &lsend("M3: U=\"$1\" X:$ndx $ttl\n") if $V>2; &msend($url,$ndx,'','',$key,$ttl); } else { &send("No match: $line\n"); } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Here we extract a symbolic name from a URL (or possibly from a title # string). It will be appended to the URL that calls the Tune CGI script, but # not used there. This is a subtle trick to make browsers see the name that # we want them to see, so if the user does a "Save", this name will be used # for the file name. But browsers can be rather flakey in this regard, and it # doesn't always work quite right. sub name { local($url,$ttl) = @_; if ($url =~ m"([^/]+)\.([^/]+)$") { return $1; } return 'UNKNOWN'; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Send a string to the client. We first check to make sure that we've sent # the HTTP header. Note that we DON'T append a newline to the string. This # routine is called with partial lines, to build up a line chunk at a time. sub send { print "Content-type: $mimetype\n\n" if !$hdrDone++; print @_; }