Detection of Appropriate Markup Language in Perl CGI Script

#!/usr/bin/perl -w

# mime_types.cgi

# Return the list of MIME types that the browser can handle
# in the appropriate markup language - HTML, XHTML MP or WML

use CGI;
my $cgi = new CGI;

my %accept = ();
foreach my $type (split /\s*\,\s*/, lc $cgi->http('HTTP_ACCEPT')) {
    $type =~ s/\s+//g;
    $type =~ s/\;.*$//;
    $accept{$type} = 1;
}

my $language = 'html';
if(exists $accept{'text/vnd.wap.wml'}) {
    $language = 'wml';
    if(exists $accept{'application/xhtml+xml'}) {
	$language = 'xhtml_mp';
    }
}

if($language eq 'wml') {
    respond_wml();
} elsif($language eq 'xhtml_mp') {
    respond_xhtml_mp();
} else {
    respond_html();
}

exit;

#-------------------------------------------------------------

sub respond_html {

   print qq[Content-type: text/html\n\n];

   print qq[<html><head><title>Browser Info - HTML</title></head>\n];
   print qq[<body bgcolor="white">\n];
   print qq[Browser Information - HTML<br>\n];

   foreach my $type (sort keys %accept) {
      print qq[$type <br>\n];
   }

   print qq[</body></html>\n];
}

#-------------------------------------------------------------

sub respond_xhtml_mp {

   print qq[Content-type: application/xhtml+xml\n\n];

   print qq[<?xml version="1.0"?>\n];
   print qq[<!DOCTYPE html PUBLIC "-//WAPFORUM//DTD XHTML Mobile 1.0//EN"\n];
   print qq["  http://www.wapforum.org/DTD/xhtml-mobile10.dtd">\n];

   print qq[<html xmlns="http://www.w3.org/1999/xhtml">\n];
   print qq[<head><title>XHTML MP</title></head>\n];
   print qq[<body bgcolor="white">\n];
   print qq[Output as XHTML MP<br/>\n];

   foreach my $type (sort keys %accept) {
      print qq[$type <br/>\n];
   }

   print qq[</body></html>\n];
}

#-------------------------------------------------------------

sub respond_wml {

   print qq[Content-type: text/vnd.wap.wml\n\n];

   print qq[<?xml version="1.0"?>\n];
   print qq[<!DOCTYPE wml PUBLIC "-//WAPFORUM//DTD WML 1.1//EN" ];
   print qq["http://www.wapforum.org/DTD/wml_1.1.xml">\n];

   print qq[<wml>\n];
   print qq[<card id="main" title="WML">\n];
   print qq[<p>Output as WML<br/>\n];

   foreach my $type (sort keys %accept) {
      print qq[$type <br/>\n];
   }

   print qq[</p></card></wml>\n];
}