use strict;
use warnings;

my @names = ('John-Boy M. Doe',
			 'John Doe',
			 'John St. Doe',
			 'John St Doe',
			 'John M. St. Doe',
			 'John M. O Doe',
			 'John M. O\'Doe');


foreach my $name (@names)
{
	NAME_TEST:
	{
		$name =~ m{^([\w\-\']+)\s*(\w*\.*)\s((?:O|St)(?:\'|\.)*\s*[\w\-\']+)} && do{print 'First/Middle/(Prefix)Last';
																					print $1.'-'.$2.'-'.$3."\n\n";
																					last NAME_TEST;};
		
		$name =~ m{^([\w\-\']+)\s*(\w*\.*)\s((?:O|St)(?:\'|\.)*\s*[\w\-\']+)} && do{print 'First/Middle/(Prefix)Last';
																					print $1.'-'.$2.'-'.$3."\n\n";
																					last NAME_TEST;}

	}
}