#$name =~ s/^(The|A|An) //i;
   $name =~ s/^(?:The|An?) //i;  # no capturing


  #for my $word (split(/[ _-]/,$name)) {
  #   push @abbr, substr($word,0,1);
  #}
   my @abbr = $name =~ /(?:_|\b)(\w)/g;


  #my $raw_abbr = $opt{periods} && $opt{periods} =~ /^[yt1]/i ? join('',map { $_ =~ s/$/./; $_; } @abbr) : join('',@abbr);

   my $raw_abbr = $opt{periods} && $opt{periods} =~ /^[yt1]/i 
                ? join('.',@abbr) . '.' 
                : join('', @abbr);


##</code><code>##

use strict;
use warnings;
my %opt = (
   periods => 0,
   ALLCAPS => 1,
   HTML    => 1,
   name    => "Compact Disc read-only memory",
);

print abbr(%opt);

sub abbr {
   my %opt    = @_;
   $opt{name} =~ s/^(?:The|An?) //i;
   die("Sorry...") unless $opt{name} =~ /\S/;

   my %ON     = map  { $_ => 1 } 
                grep { $opt{$_} =~ /^[yt1]$/i } 
                keys %opt;

   return   ($ON{HTML} ? qq{<abbr title="$opt{name}">} : "")
          . ( join '',
              map { $_ = $ON{ALLCAPS} ? uc    : $_;
                    $_ = $ON{periods} ? "$_." : $_;
                  }
              $opt{name} =~ /(?:_|\b)(\w)/g 
            )
          . ($ON{HTML}  ? qq{</abbr>} : "")
}

##</code><code>##

   /(The|A|An)/;

##</code><code>##

   /((?:The|A|An))/;