Lingua::EN::Parse::PersonsName does a pretty good job with this:

#!/usr/bin/perl -wl
use strict;
use Lingua::EN::Parse::PersonsName;

while (<DATA>) {
    chomp();

    # Get rid of the stuff we don't need on either end of the string
    my ($fullname) = $_ =~ /^\'\s+(.*?)\'$/;

    my $parser = Lingua::EN::Parse::PersonsName->new($fullname);
    print join(" ",$parser->fname, $parser->mi, $parser->lname);
}

__DATA__
'   Smith, John'
'   Thompson, Frank A'
'   Smith, John A JR'
'   Smith, John A III'
'   Smith, John A (Johnny)'
' Robert E Smith'
'   Fred E.J.K Flintstone III'
[download]

John  Smith
Frank A Thompson
John A Smith
John A Smith
John A Smith
Robert E Smith
Fred E Flintstone
[download]

Cheers,
Darren :)

If you're sure there's always going to be whitespace between names, you could do something like this:

sub parse_name {
    my ($namestr) = @_;
    my @names = split(/\s+/, $namestr);
    my ($last, $first, $middle) = ($names[0], $names[1], $names[2]);
    $last =~ s/,$//;
    $middle ||= "";
    return [ $first, $middle, $last ];
}
[download]

Note that the subroutine also trims any comma from the end of the last name, and returns a blank middle name if one wasn't defined.

Now call the subroutine parse_name() with a name string, and you'll get a reference to a list containing the first, middle, and last names.  For example:

                                                                      
+    
use strict;
use warnings;
                                                                      
+          
my @data = (
    'Smith, John',
    'Thompson, Frank A',
    'Smith, John A JR',
    'Smith, John A III',
    'Smith, John A (Johnny)',
);

foreach my $name (@data) {
    my $p = parse_name($name);
    printf "First(%10.10s)   Middle(%5.5s)   Last(%10.10s)\n", @$p;
}

__END__

Output:
First(      John)   Middle(     )   Last(     Smith)
First(     Frank)   Middle(    A)   Last(  Thompson)
First(      John)   Middle(    A)   Last(     Smith)
First(      John)   Middle(    A)   Last(     Smith)
First(      John)   Middle(    A)   Last(     Smith)
[download]

Update:  Added test code.

my ($last_name, $first_name, $middle_initial) = ( $_ =~ /(\w+)\W*?(\w+
+)\s?(\w)?/) ;
[download]

sub parse_name {
    my ($last, $first, $mi) = ( $_[0] =~ /(\w+)\W*?(\w+)\s?(\w)?/) ;
    return [$first, $last, $mi];
}
[download]

your solution ignores the name in case there's no middle initial (or just no trailing spaces), which is the first example. adding \W* or \s* instead of a single blank space fixes this.
/(\w+)\W*?(\w+)\W*(\w)?/

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*women.pm

Thanks, I noticed that, too, when I changed it to plug into the test case. Fairly embarrasing considering I do name parsing such as this regularly at work!