bin/name_chooser.pl

   1 #! /usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 while (<>) {
   7      chomp;
   8      my @names = split /;\s*/;
   9      @names = sort {length $b <=> length $a } @names;
  10      # pick the longest name
  11      my $name = $names[0];
  12      # strip out long parenthetical statements
  13      $name =~ s/[\[\(][^\]\)]{10,}[\]\)]//g;
  14      $name =~ s/(\s)\s+/$1/g;
  15      print $name,qq(\n);
  16 }