#! /usr/bin/perl

use warnings;
use strict;

while (<>) {
     chomp;
     my @names = split /;\s*/;
     @names = sort {length $b <=> length $a } @names;
     # pick the longest name
     my $name = $names[0];
     # strip out long parenthetical statements
     $name =~ s/[\[\(][^\]\)]{10,}[\]\)]//g;
     $name =~ s/(\s)\s+/$1/g;
     print $name,qq(\n);
}
