#	    Extract a documentation section from a CWEB file
    
    #	    	    John Walker  --  October 2002
    
    #	perl cwebextract.pl cwebfile.w 'section name'
    
    #	This program searches cwebfile.w for the specified
    #	'section name' (which must appear on the line containing
    #	the "@" introducing the section--matching is case insensitive
    #	and the first partial match is accepted).  The documentation
    #	following on subsequent lines until the next line with an
    #	"@" in column 1 (or end of file) is copied to standard
    #	output with initial and trailing blank lines discarded.
    #
    #	This program is usually employed to extract TeX documentation
    #	from a CWEB file for translation to other documentation
    #	languages, for example, by the cwebtex2man.pl program in
    #	this directory.
    
    #	Validate command line arguments and open
    #	input file.
    
    if ($#ARGV != 1) {
    	print(STDERR "Usage: perl cwebextract.pl cwebfile.w 'section name'\n");
	exit(2);
    }
    $ifname = $ARGV[0];
    open(FI, "<$ifname") || die("Cannot open input file $ifname");
    $sec = $ARGV[1];	    	# Requested section name
    $isec = $sec;   	    	# Save for diagnostics
    #	Transform Perl regular expression metacharacters into
    #	quoted literal characters for section search.
    $sec =~ s/([\\\^\.\$\|\(\)\[\]\*\+\?\{\}])/\\$1/g;
#print("Transformed pattern: <<$sec>>\n");
    $ln = 0;
    
    #	Search for requested section
    
    while (&nextline) {
    	if (($l =~ m/^\@[\*\s]*/) &&
	    ($l =~ m/^\S+.*$sec/i)) {
#print("Found: $l\n");
    	    last;
	}
    }
    
    if (!(defined $l)) {
    	print(STDERR "Section name \"$isec\" not found in $ifname.\n");
	goto bail;
    }
    
    #	Ignore blank lines before start of section text
    
    while (&nextline && defined($l) && (length($l) > 0)) {
    }
    
    if (!(defined $l)) {
    	print(STDERR "Section name \"$isec\" is void in $ifname.\n");
	goto bail;
    }
    
    #	Accumulate lines from section in array.  We store the
    #	lines in an array to permit trimming trailing blank
    #	lines without tangled logic.
    
    $n = 0;
    while (&nextline && defined($l) && (!($l =~ m/^\@/))) {
    	$text[$n++] = $l;
    }
    
    #	End of section.  Trim trailing blank lines.
    
    while (($n > 0) && (length($text[$n - 1]) == 0)) {
    	$n--;
    }
    
    #	Emit trimmed section to standard output.
    
    for ($i = 0; $i < $n; $i++) {
    	print("$text[$i]\n");
    }
    
    exit(0);	    	# Success
    
bail:
    close(FI);
    exit(1);    
    
    #	Read the next line into $l, stripping trailing spaces.
    #	Returns 1 for success, 0 at end of file.
    
    sub nextline {
	if ($l = <FI>) {
	    $l =~ s/\s*$//;
	    $ln++;
	    return 1;
	}
	undef $l;
	return 0;
    }