#!/usr/bin/perl -w
################################################################
#
# Hack of a program to check for unbalanced html tags.
#
# % tagmatch [-t tag [-t tag [...]]] [file1 file2 ...]
#
# By default, it checks for:
my @lookfor = qw(
    blockquote
    center
    div
    dl
    ol
    table
    tbody
    td
    thead
    tr
    ul
);
#
#
################################################################

use strict;

my %matchers = ();	# hash of stacks... $matchers{'foo'}
			# is the list of all locations
			# where there was an opening 'foo' tag.

my @stack = ();		# stack of open tags that we are tracking...

add_default_matchers();
add_matchers_from_command_line();

check_all_input();
complain_about_unclosed_tags();

#----------------------------------------------------------------------
sub check_all_input {
    my $lastTag = undef;

    while ( <> ) {
	foreach my $token ( m!<\w+|</\w+|/>!g ) {
	    my $isopen = ( $token =~ m!/! ) ? 0 : 1;
	    my $tag = lc $token;
	    $tag =~ s!</?!!g;

	    if ( $tag eq '/>' ) {
		$tag = $lastTag;
		$lastTag = undef;
	    }
	    else {
		$lastTag = $tag;
	    }

	    if ( exists $matchers{ $tag } ) {
		if ( $isopen ) {
		    tag_open( $tag, $., $ARGV );
		    push @stack, $tag;
		}
		else {
		    if ( tag_close( $tag, $., $ARGV ) ) {
			check_stack( $tag, $., $ARGV );
		    }
		}
	    }
	}
    }
}

#----------------------------------------------------------------------
sub complain_about_unclosed_tags {
    foreach my $tag ( sort keys %matchers ) {
	my @info = get_unclosed( $tag );
	if ( @info ) {
	    print STDERR "Unclosed <$tag> at ", join( ', ', @info ), "\n";
	}
    }
}

#----------------------------------------------------------------------
sub add_default_matchers {
    foreach my $tag ( @lookfor ) {
	add_matcher( $tag );
    }
}

#----------------------------------------------------------------------
sub add_matchers_from_command_line {
    while ( @ARGV && $ARGV[0] =~ m/^-{1,2}t/ ) {
	add_matcher( $ARGV[1] );
	shift @ARGV;
	shift @ARGV;
    }
}

#----------------------------------------------------------------------
sub add_matcher {
    my ( $tag ) = @_;
    $matchers{ lc $tag } = [ ];
}

#----------------------------------------------------------------------
sub tag_open {
    my ( $tag, $line, $file ) = @_;
    push @{ $matchers{$tag} }, "$line of $file";
}

#----------------------------------------------------------------------
sub tag_close {
    my ( $tag, $line, $file, $msg ) = @_;
    if ( @{ $matchers{$tag} } ) {
	my $info = pop @{ $matchers{$tag} };
	if ( $msg ) {
	    print STDERR "$msg from $info\n";
	}
	return 1;
    }
    else {
	print STDERR "Unopened </$tag> at $line of $file\n";
	return 0;
    }
}

#----------------------------------------------------------------------
sub get_unclosed {
    my ( $tag ) = @_;
    return @{ $matchers{ $tag } }
}

#----------------------------------------------------------------------
sub check_stack {
    my ( $tag, $line, $file ) = @_;

    while ( @stack ) {
	my $expected = pop @stack;
	if ( $expected ne $tag ) {
	    my $msg = "At </$tag> on $line of $file"
		. ", auto-closing <$expected> tag";
	    tag_close( $expected, $line, $file, $msg );
	}
	else {
	    last;
	}
    }
}