Fixed fallback on failed content negotiations.
[MyWeb.git] / Web.pm
diff --git a/Web.pm b/Web.pm
index 8b1859c..3eb176b 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -202,8 +202,8 @@ my($class,%args)=@_;
                $W->{"args"}{$name}=[@vals];
                }
 
-       do { $W->{$_}=$W->{"r"}->headers_in()->{"Accept"}     if !defined $W->{$_}; } for ("accept");
-       do { $W->{$_}=$W->{"r"}->headers_in()->{"User-Agent"} if !defined $W->{$_}; } for ("user_agent");
+       do { $W->{$_}=$W->{"r"}->headers_in()->{"Accept"}         if !defined $W->{$_}; } for ("accept");
+       do { $W->{$_}=$W->{"r"}->headers_in()->{"User-Agent"}||"" if !defined $W->{$_}; } for ("user_agent");
 
        $W->{"browser"}=HTTP::BrowserDetect->new($W->{"user_agent"});
 
@@ -654,7 +654,7 @@ my($self,$variants)=@_;
                        # Do not: HTTP::Headers->new($W->{"r"}->headers_in());
                        # to prevent empty result or even: Odd number of elements in anonymous hash
                        HTTP::Headers->new(%{$W->{"r"}->headers_in()}));
-       $best||=$variants->[0]{"id"};   # &HTTP::Negotiate::choose failed?
+       $best||=$variants->[0][0];      # $variants->[0]{"id"}; &HTTP::Negotiate::choose failed?
        return $best;
 }
 
@@ -783,12 +783,14 @@ my($class)=@_;
        # FIXME: It is not clean to still append them without overwriting.
        return if $W->{"heading_done"}++;
 
-       my $lang=($W->{"language"}||"en-US");
        # Workaround bug
        #   https://bugzilla.mozilla.org/show_bug.cgi?id=120556
        # of at least
        #   Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8b) Gecko/20050217
-       my $mime=$class->Negotiate_choose([
+       my $mime;
+       # http://validator.w3.org/ does not send ANY "Accept" headers!
+       $mime||="application/xhtml+xml" if !$W->{"accept"} && $W->{"user_agent"}=~m{^W3C_Validator/}i;
+       $mime||=$class->Negotiate_choose([
                        # Put the fallback variant as the first one.
                        # Rate both variants the same to prefer "text/html" for undecided clients.
                        # At least
@@ -800,24 +802,23 @@ my($class)=@_;
                                        "content-type"=>"text/html",
                                        "qs"=>0.6,
                                        "charset"=>$client_charset,
-                                       "lang"=>$lang,
+                                       "lang"=>$W->{"language"},
                                        ),
                        negotiate_variant(
                                        "id"=>"application/xhtml+xml",
                                        "content-type"=>"application/xhtml+xml",
                                        "qs"=>0.6,
                                        "charset"=>$client_charset,
-                                       "lang"=>$lang,
+                                       "lang"=>$W->{"language"},
                                        ),
                        # application/xml ?
                        # text/xml ?
                        ]);
        $W->{"r"}->content_type("$mime; charset=$client_charset");
-       if (1) { # (|| !$msie_major || $msie_major>=4) # TODO:dyn
-               Wprint '<?xml version="1.0" encoding="'.$client_charset.'"?>'."\n";
-               }
+       Wprint '<?xml version="1.0" encoding="'.$client_charset.'"?>'."\n" if $mime=~m{^application/\w+[+]xml$};
+       return if $W->{"xml_header_only"};
        Wprint '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">'."\n";
-       Wprint '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="'.$lang.'">'."\n";
+       Wprint '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="'.$W->{"language"}.'">'."\n";
        my $title=$W->{"title_prefix"}.join("",map({ ': '.$_; } ($W->{"title"} || ())));
        $title=~s#<[^>]*>##g;
        Wprint "<head>";