#!/usr/bin/perl

use strict;
use warnings;

my $infile = shift;  # get input file name from @ARGV

open( my $fh, "<:utf8", $infile ) or die $!;
local $/;   # slurp the whole file in the next line
$_ = <$fh>;

s/^<\?.*>\s+//;  # ditch the "<?xml...?>" line, if any

my %open_tags;
my %close_tags;

for my $tkn (split/(?<=>)|(?=<)/) {  # split on look-behind | look-ahead for brackets
    if ( $tkn =~ m{^<(\/?)(\w+)} ) {
        if ( $1 eq '' ) {
            $open_tags{$2}++;
        }
        else {
            $close_tags{$2}++;
        }
    }
}

for my $tag ( sort keys %open_tags ) {
    if ( ! exists( $close_tags{$tag} )) {
        warn sprintf( "%s: open tag %s is never closed in %d occurrence(s)\n",
                      $infile, $tag, $open_tags{$tag} );
    }
    else {
        if ( $close_tags{$tag} != $open_tags{$tag} ) {
            warn sprintf( "%s: element %s has %d open tags but %d close tag(s)\n",
                          $infile, $tag, $open_tags{$tag}, $close_tags{$tag} );
        }
        delete $close_tags{$tag};
    }
}

for my $tag ( keys %close_tags ) {
    warn sprintf( "%s: close tag %s has no open tags in %d occurrence(s)\n",
                  $infile, $tag, $close_tags{$tag} );
}