$W->{"browser"} is now lazy-evaluated for proper "headers_in" hits.
authorshort <>
Wed, 21 Sep 2005 12:49:43 +0000 (12:49 +0000)
committershort <>
Wed, 21 Sep 2005 12:49:43 +0000 (12:49 +0000)
Avoid invalid empty "Vary" header.
Support inhibiting: charset
Support forcing outpit Content-Type by: $W->{"content_type"}
Autodetect output text type for possible 'charset' omitting.
+Support: $W->{"header_only"}="xml";

Web.pm

diff --git a/Web.pm b/Web.pm
index 89b5604..cabea9d 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -126,6 +126,7 @@ use Apache2::Filter;
 use Apache2::Connection;
 require MIME::Base64;
 use Apache2::ServerUtil;
+require MIME::Types;
 
 
 #our $W;
@@ -248,7 +249,10 @@ my($class,%args)=@_;
                $W->{"headers_in"}=$W->{"headers_in_RecordKeys"};
                }
 
-       $W->{"browser"}=HTTP::BrowserDetect->new($W->{"headers_in"}{"User-Agent"});
+       $W->{"browser"}=sub {
+               # Lazy-evaluation, we may not need the "User-Agent" header at all.
+               return our $r||=HTTP::BrowserDetect->new($W->{"headers_in"}{"User-Agent"});
+               };
 
        if (!defined $W->{"have_style"}) {
                $W->{"have_style"}=(!$W->{"browser"}->netscape() || ($W->{"browser"}->major() && $W->{"browser"}->major()>4) ? 1 : 0);
@@ -1035,7 +1039,7 @@ sub cache_finish()
                delete $Vary{$_};
                }
        %Vary=("*"=>1) if $Vary{"*"};
-       $headers_out{"Vary"}=join(", ",sort keys(%Vary));
+       $headers_out{"Vary"}=join(", ",sort keys(%Vary)) if keys(%Vary);
        # $W->{"r"}->set_last_modified() ?
        $headers_out{"Last-Modified"}=cache_finish_last_modified();
 
@@ -1066,19 +1070,20 @@ my($class)=@_;
        # TODO: Support also: private
        header("Cache-Control"=>"public");      # HTTP/1.1
 
-       # $ENV{"CLIENT_CHARSET"} ignored (mod_czech support dropped!)
-       my $client_charset=$W->{"force_charset"} || "us-ascii";
+       # Use $W->{"force_charset"}=0 to disable charset.
+       my $client_charset=$W->{"force_charset"};
+       $client_charset="us-ascii" if !defined $client_charset;
 
        # 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;
+       my $mime=$W->{"content_type"};
        # http://validator.w3.org/ does not send ANY "Accept" headers!
-       $mime||="application/xhtml+xml" if 1
+       $mime="application/xhtml+xml" if !$mime
                        && !$W->{"headers_in"}{"Accept"}
                        && ($W->{"headers_in"}{"User-Agent"}||"")=~m{^W3C_Validator/}i;
-       $mime||=$class->Negotiate_choose([
+       $mime or $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
@@ -1104,16 +1109,21 @@ my($class)=@_;
                        ]);
        # mod_perl doc: If you set this header via the headers_out table directly, it
        #               will be ignored by Apache. So do not do that.
-       $W->{"r"}->content_type("$mime; charset=$client_charset");
+       my $type=MIME::Types->new()->type($mime) if $client_charset;
+       cluck "MIME::Types type $mime not known" if $client_charset && !$type;
+       $client_charset=undef() if $type && !$type->isAscii();
+       $W->{"r"}->content_type($mime.(!$client_charset ? "" : "; charset=$client_charset"));
 
        cache_start();
-       return if $W->{"header_only"};
        # We still can append headers before we put out some text.
        # FIXME: It is not clean to still append them without overwriting.
-       return if $W->{"heading_done"}++;
+       return if $W->{"heading_done"};
+       Wprint '<?xml version="1.0" encoding="'.$client_charset.'"?>'."\n"
+                       if (!$W->{"header_only"} || $W->{"header_only"} eq "xml") && $mime=~m{^application/\w+[+]xml$};
+       return if $W->{"header_only"};
+       # Split 'heading_done' for the proper handling of: /project/Rel.pm
+       $W->{"heading_done"}++;
 
-       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="'.$W->{"language"}.'">'."\n";
        my $title=$W->{"title_prefix"}.join("",map({ ': '.$_; } ($W->{"title"} || ())));