(almost) matches well-formed XML

badass_regexp.pl

#!/usr/bin/perl

use strict;
use warnings;

use 5.012;

use Test::More tests => 18;

my @success = ("<content><test>testing</test><test>woo</test></content>",
               "<content></content>",
               "<content><test>words<bear>monkey</bear></test></content>",
               "<sup bear=\"mother\"><test><apple monkey=\"carbeurator\"></apple></test></sup>",
               "<sup /><test><sup /></test>",
               "<sup />",
               "<sup test=\"hi\" />",
               "<test><sup test=\"hi\" /></test>");

my @fail = ("<content><dicks><woo></dicks></content>",
            "<content>",
            "<content woo></content>",
            "<content woo=test></content>",
            "<test><content></test></content>",
            "<sup /></sup>",
            "<sup /><sup>",
            "<test></test></test>",
            "<content></content><test></test>",
            "<test><sup></test>");

my $regexp = qr{^(<(\w+?)(?: \w+=".+?")*(?(?=\s/>)\s/>(?1)?|>[^<>]*(?>(?1)*</\2>))$};
foreach my $input (@success) {
        like($input, $regexp);
}

foreach my $input (@fail) {
        unlike($input, $regexp);
}