use strict; use warnings; use Test::More 'no_plan'; my $dom = qr{ [a-z] # starts with a letter [a-z0-9-]* # zero or more letters, numbers, hyphens }xi; my $au = qr{ $dom \. # company $dom \. # subdomain au # ccTLD \. ? # optional trailing dot \b # word break }xi; my $com = qr{ $dom \. # company com # gTLD \. ? # optional trailing dot \b # word break }xi; my $domain = qr{ (?: # start of group $dom \. # company subdomain ) ? # end of group, make it optional (?: # start of group $com # .com pattern | # or $au # .au pattern ) # end of group }xi; my @no_match = qw( illegal_underscore.com example.unreal.dom too-short.au 0digits-allowed.com ); foreach my $bad ( @no_match ) { unlike( $bad, $domain, "no match: '$bad'" ); } my %match_for = ( 'foo.sub.example.com' => 'sub.example.com', 'bar.sub.example.com.au' => 'sub.example.com.au', ); while ( my ( $stuff, $find ) = each %match_for ) { my $test_name = "match: '$stuff'"; if ( $stuff =~ qr{ ( $domain ) }x ) { my $matched = $1; pass( $test_name ); is( $matched, $find, "found: '$find'" ); } else { fail( $test_name ); } }