sub abbr { my %opt = @_; die("Sorry, I can't return an abbreviation if you don't give me a name.") if !$opt{name}; my $name = $opt{name}; $name =~ s/^(The|A|An) //i; if ($name !~ /[ _-]/) { return $opt{name}; } else { my @abbr; for my $word (split(/[ _-]/,$name)) { push @abbr, substr($word,0,1); } my $raw_abbr = $opt{periods} && $opt{periods} =~ /^[yt1]/i ? join('',map { $_ =~ s/$/./; $_; } @abbr) : join('',@abbr); my $final_abbr = $opt{ALLCAPS} && $opt{ALLCAPS} =~ /^[yt1]/i ? uc $raw_abbr : $raw_abbr; if ($opt{HTML} && $opt{HTML} =~ /^[yt1]/i) { return qq($final_abbr); } else { return $final_abbr; } } } sub initials { my %opt = @_; my $initials = abbr( name => $opt{name} ? $opt{name} : die("Sorry, I can't return initials if you don't give me a name."), periods => $opt{periods} ? $opt{periods} : undef, ALLCAPS => $opt{ALLCAPS} ? $opt{ALLCAPS} : undef, HTML => $opt{HTML} ? $opt{HTML} : undef, ); return $initials; }