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>} : "")
}