#!path to perl
use strict;

my %tags;
my @errors;
my $var_containing_message = qq#
Hello everyone!<p>

This is a sample test of the things that the <strong>awesome</b> language
perl can do!<p>

Anyway, when I say <pre>$|++</pre> I am changing buffering!
#;

#Just a list of all allowed tags (opening and closing)
#I had to get rid of the CODE entries to post this
#Also, this list is incomplete. DO note however,
#that I did not include <i>, <b>, or <u>
#<strong> and <em> are much better :)
my @allowed_tags = qw(
p /p br ul /ul li ol /ol em /em strong /strong small /small sub /sub sup /sup pre /pre
);

#A list of the tags from @allowed_tags list
#that REQUIRE a closing tag
my @match_required = qw(ul ol em strong pre small sub sup);

#Here it is! The code that makes sure all closing
#tags are in the message somewhere
#loop through to find each HTML tag in message
#This counts up all the different HTML tags
while ($var_containing_message =~ /<(.*?)>/gs) {
my $tmp = lc($1);
$tags{$tmp}++;
}

#Loop through all the found HTML tags and see if
#any not-permitted/invalid ones are in there
foreach my $found_tag (keys(%tags)) {
my $allow = 0;
foreach my $permitted_tag (@allowed_tags) {
if ($found_tag eq $permitted_tag) { $allow = 1; }
}
if ($allow != 1) { push @errors, "Tag Not Allowed: $found_tag"; }
}


#Loop through all the tags requiring closing tags
#If they do not have the same # of opening/closing tags,
#generate and present the error to the poster
foreach (@match_required) {
if ($tags{$_} != $tags{"/" . $_}) {
#Here is where the error is generated and presented to the poster
#Example:
push @errors, "Mismatched Tags: <$_> and </$_>";
}
}

if (@errors == 0) {
print "hey, it's all good!";
} else {
print "Whoops. There is a problem...\n";
print "$_\n" foreach (@errors);
}
sleep 3; exit;