#!/usr/athena/bin/perl

#These are tags which do not require a matching closing tag
%openonly = ('img', 1,
	     'li', 1,
	     'p', 1,
	     'hr', 1,
	     '', 1,
	     'input', 1,
	     'dd', 1,
	     'dt', 1,
	     'option', 1,
	     'br', 1,
	     '!', 1,
	     'link', 1,
	     'fnord', 1,
	     '!img', 1,
	     'plaintext', 1,
	     );


while(<>){
    #Read all the lines from the files into an associative array
    #keyed on the filename.
    $files{$ARGV} .= $_;
}

for $file (keys %files){
    #Enable multi-line string matching
#    $*=1;

    #Clear the list of tags which are still open.
    @tags = ();

    #Remove all newlines from the file.
#    $files{$file} =~ s/(\S)[\s\n]+(\S)/\1 \2/g; # Cleaned up

    # $data now contains the text for the file.
    $data = $files{$file};


    #Set $fileprefix for error messages
    $fileprefix = "$file:" if $#ARGV;

    $line_no = 0;
    foreach $line (split ("\n", $data)){
	$line_no++;
#	print "$line_no : $line\n";

	#Initialize $found
	$found = 1;
	
	while ($found)
	{
	    
	    #Try to find a valid tag
	    $found = ($line =~ /<([^> \t\n]+)([^>]*)/);
	    next unless $found;

	    #Put the text of the tag in $1, the rest of the tag in $2
	    #and the string which follows the match.
	    $tag = $1;
	    $lchar = $2;
	    $after = $';
	    #Make all tags lower case for ease of comparison
	    $tag =~ y/A-Z/a-z/;

	    $full_tag = "<" . $tag. $lchar;

#	print("Looking at tag $tag\n");
#	print("Followed by ", substr($after, 0, 10), "\n");

	    #Call closetag if the tag begins with a /
	    if(substr($tag, 0, 1) eq '/'){
		&closetag(substr($tag,1), $full_tag);
	    }
	    #Otherwise call newtag
	    else{
		&newtag($tag, $full_tag);
	    }
	    
	    #Move down the file.
	    $line = $after;
	}
    }
    
    #Report Errors for the File
    
    #If there are still some unclosed tags, report them.
    if($#tags != -1){
#	print("Tags not closed in $file: @tags\n");
	foreach $tag_message (@tags)
	{
	    print $tag_message; 
	}

	$status{$file} =1;
    }
    
    if(!$status{$file}){
	print("OK: $file\n");
    }
}

sub newtag {
    local($nt, $ft) = @_;

    #If the tag is openonly, there is no need to add it to @tags
    return if($openonly{$nt});
    
    #If the new tag is an anchor and there is already an anchor on
    #the list of unclosed tags, report a nesting error.
    if($nt eq "a" && grep(/^a$/, @tags)){
	print("$fileprefix", "Line $line_no :", "Opening nested anchors\n");
	$status{$file}=1;
	return;
    }
    
    #Push a possible error messge on to @tags
    $new_tag_msg = "$fileprefix" . "$line_no:" . "$ft tag opened without being closed\n";
    push(@tags, $new_tag_msg);
#    print("Opening tag: $nt\n");

}

sub closetag {
    local($ct, $ft) = @_;

#    print "Closing $ct\n";
    # If it is an openonly tag (which should be impossible), there
    # is no need to pop anything off @tags
    return if $openonly{$ct};

    # Check the last tag pushed onto @tags.  If they match, then it
    # was properly closed.

    $last_tag_msg = $tags[$#tags];
    @parts = split (":", $last_tag_msg);
#    print "Trying to match <$ct against $parts[2]\n";

    if($parts[2] =~ /^<$ct[ >]/)
    {
#	print("Close tag $ct\n");
	pop(@tags);
    }
    
    # Otherwise, it was improperly closed.
    else
    {			       
	# Check to see if there is still a dangling open tag of the right
	# type.

	if(grep(/:<$ct/, @tags)){
	    #Grab the last open tag message
	    $last_tag_msg = $tags[$#tags];

	    #Find the actual tag which was opened
	    @parts = split (":", $last_tag_msg,3);
	    $last_tag = $parts[2];

	    #Clean it up
	    chop($last_tag);
	    $last_tag =~ s/>.+/>/;
	    
	    print("$fileprefix","$line_no:", "$ft is closed before \"$last_tag\"\n");
	}
	
	# Otherwise, report a missing open tag
	else{		       
	    print("$fileprefix", "$line_no:", "$ft is closed without being opened\n");
	}
	$status{$file} = 1;
    }
}