Test for RegExp, grabbing first name - http://www.perlmonks.org/?node_id=1156197

1156197.pl

#!/usr/bin/env perl
use 5.011;    # implies strict + feature 'say'
use warnings;

use Test::More;

my %names = (

    #           Test data
    #   input              expected output
    'BULLOCK JOE A'     => 'JOE',
    'SMITH, A DOE'      => 'DOE',
    'BULLOCK MICHAEL A' => 'MICHAEL',

    # not specified by OP:
    'SMITH ADAM'       => 'ADAM',
    'POCAHONTAS'       => 'POCAHONTAS',
    'TRAPPER JOHN M D' => 'JOHN',
);

my %approaches = (

    'hippo' => sub {
        my ( $sname, $fname ) = shift =~ /([A-Z]{3,})/g;
        return $fname || $sname;
    },

    'Maresia' => sub {
        my $string = shift;
        if ( $string =~ /(\w{3,})$/ ) {
            return $1;
        }
        elsif ( $string =~ /(\w+)\s(\w{1,2})$/ ) {
            return $1;
        }
    },

    'kcott' => sub {
        shift =~ /^[^, ]+(?:,\s+\w+|)\s+(\w+)/;
        return $1;
    },
);

plan tests => scalar keys %approaches;
for my $who ( keys %approaches ) {
    print "\nRunning tests for $who:\n\n";
    subtest(
        $who,
        sub {
            plan tests => scalar keys %names;
            my $get_forename = $approaches{$who};
            for my $fullname ( keys %names ) {
                my $fname = $get_forename->($fullname);
                no warnings 'uninitialized';
                is( $fname, $names{$fullname},
                    "wanting forename '$names{$fullname}'  from '$fullname'" );
            }
        }
    );
    print "\n";
}