+ header("Vary"=>"*"); # content may ba based on unpredictable sources
+}
+
+sub headers_in_filtered(@)
+{
+my(@keys)=@_;
+
+ return map(($_=>$W->{"headers_in"}{$_}),@keys);
+}
+
+our %uri_args_frozen_to_headers_in_keys;
+our %uri_args_headers_in_frozen_to_headers_out;
+
+sub uri_args_headers_in_frozen_get($)
+{
+my($headers_in_keys_arrayref)=@_;
+
+ my %uri_args_headers_in_hash=(
+ "uri_args_frozen"=>$W->{"uri_args_frozen"},
+ "headers_in"=>{ headers_in_filtered(@$headers_in_keys_arrayref) },
+ );
+ return do { local $Storable::canonical=1; Storable::freeze(\%uri_args_headers_in_hash); };
+}
+
+sub cache_output_filter($)
+{
+my($f)=@_;
+
+ while ($f->read(my $text,0x400)) {
+ cluck "utf-8 untested" if Encode::is_utf8($text); # Possible here at all?
+ $f->print($text);
+ $W->{"digest-md5"}->add($text);
+ }
+ return OK;
+}
+
+sub cache_start()
+{
+ if (!$W->{"http_safe"}) {
+ __PACKAGE__->_no_cache();
+ return;
+ }
+
+ {
+ # &Wrequire it here even if it will not be later used; to be stable!
+ Wrequire 'My::Hash::RestrictTo';
+ my %uri_args_hash=(
+ "uri"=>"http://".$W->{"web_hostname"}."/".$W->{"r"}->uri(),
+ "args"=>$W->{"args_orig_array"},
+ );
+ $W->{"uri_args_frozen"}=do { local $Storable::canonical=1; Storable::freeze(\%uri_args_hash); };
+ last if !(my $headers_in_keys_arrayref=$uri_args_frozen_to_headers_in_keys{$W->{"uri_args_frozen"}});
+
+ # Protection to be sure we are stable:
+ $W->{"headers_in"}=My::Hash::RestrictTo->new($W->{"headers_in"},@$headers_in_keys_arrayref);
+
+ $W->{"uri_args_headers_in_frozen"}=uri_args_headers_in_frozen_get($headers_in_keys_arrayref);
+ last if !(my $headers_out_hashref=$uri_args_headers_in_frozen_to_headers_out{$W->{"uri_args_headers_in_frozen"}});
+ header(%$headers_out_hashref);
+ my $status;
+ {
+ # &meets_conditions will always deny the attempt if !2xx status().
+ # At least ap_read_request() sets: r->status=HTTP_REQUEST_TIME_OUT; /* Until we get a request */
+ my $status_old=$W->{"r"}->status();
+ $W->{"r"}->status(HTTP_OK);
+ # Update httpd's 'r->mtime' as the header "Last-Modified" is just not enough for ap_meets_conditions():
+ # &update_mtime() argument is really in _secs_, not in _msecs_ as the docs claim.
+ # Be aware '*1000000' would overflow Perl integer anyway.
+ # &set_last_modified would also override the "Last-Modified" headers_out!
+ # &mtime may exist but somehow does not work.
+ $W->{"r"}->update_mtime(HTTP::Date::str2time($headers_out_hashref->{"Last-Modified"}));
+ $status=$W->{"r"}->meets_conditions();
+ $W->{"r"}->status($status_old);
+ }
+ last if OK==$status;
+ $W->{"r"}->status($status);
+ exit 0;
+ die "NOTREACHED";
+ }
+
+ $W->{"digest-md5"}=Digest::MD5->new();
+ $W->{"cache_active"}=1;
+ $W->{"r"}->add_output_filter(\&cache_output_filter);
+}
+
+sub cache_finish_last_modified()
+{
+ cluck "Not yet done now? W __PACKAGE__: ".$W->{"__PACKAGE__"}
+ if !$packages_used_hash{$W->{"__PACKAGE__"}}{"_done"};
+ for my $package_orig (@{$packages_used_array{$W->{"__PACKAGE__"}}}) {
+ local $_=$package_orig.".pm";
+ s{::}{/}g;
+ path_abs_disk "/$_","register"=>1;
+ }
+ my $mtime_newest;
+ for my $path_abs_disk (keys(%{$W->{"path_abs_disk_register"}})) {
+ my $mtime=(stat $path_abs_disk)[9];
+ do { cluck "No mtime for: $path_abs_disk"; next; } if !$mtime;
+ $mtime_newest=$mtime if !$mtime_newest || $mtime_newest<$mtime;
+ }
+ cluck "No mtime_newest found for the current W __PACKAGE__: ".$W->{"__PACKAGE__"}
+ if !$mtime_newest;
+ return HTTP::Date::time2str($mtime_newest);
+}
+
+
+sub cache_finish()
+{
+ # Do not: return if !$W->{"uri_args_frozen"};
+ # as we may have just gave 304 and 'exit 0;' without starting the caching.
+ return if !$W->{"cache_active"};
+
+ # Fill-in/check: %uri_args_frozen_to_headers_in_keys
+ my $headers_in_keys_stored_arrayref_ref=\$uri_args_frozen_to_headers_in_keys{$W->{"uri_args_frozen"}};
+ my @headers_in_keys=tied(%{$W->{"headers_in_RecordKeys"}})->accessed();
+ if (!$$headers_in_keys_stored_arrayref_ref
+ || !Data::Compare::Compare(\@headers_in_keys,$$headers_in_keys_stored_arrayref_ref)) {
+ cluck "Non-matching generated 'headers_in_keys' per 'uri_args_frozen' key:\n"
+ .Dumper(\@headers_in_keys,$$headers_in_keys_stored_arrayref_ref)
+ if $$headers_in_keys_stored_arrayref_ref;
+ # Build or possibly prevent such further warn dupes:
+ $$headers_in_keys_stored_arrayref_ref=\@headers_in_keys;
+ # Build or regenerate as obsoleted now:
+ $W->{"uri_args_headers_in_frozen"}=uri_args_headers_in_frozen_get(\@headers_in_keys);
+ }
+
+ # Prepare 'headers_out' for the future reusal:
+ my %headers_out;
+ $headers_out{"Content-MD5"}=$W->{"digest-md5"}->b64digest();
+ # In fact we could also use MD5 for ETag as if we know ETag we also know MD5.
+ # But this way we do not need to calculate MD5 and we still can provide such ETag. So.
+ # $W->{"r"}->set_etag() ?
+ $headers_out{"ETag"}='"'.Digest::MD5::md5_base64($W->{"uri_args_headers_in_frozen"}).'"';
+ # $W->{"r"}->set_content_length() ?
+ $headers_out{"Content-Length"}=$W->{"r"}->bytes_sent();
+ my %Vary=map(($_=>1),(@headers_in_keys));
+ for (keys(%Vary)) {
+ next if !/^_/;
+ $Vary{"*"}=1;
+ delete $Vary{$_};
+ }
+ %Vary=("*"=>1) if $Vary{"*"};
+ $headers_out{"Vary"}=join(", ",sort keys(%Vary));
+ # $W->{"r"}->set_last_modified() ?
+ $headers_out{"Last-Modified"}=cache_finish_last_modified();
+
+ # Fill-in/check: %uri_args_headers_in_frozen_to_headers_out
+ my $headers_out_stored_hashref_ref=\$uri_args_headers_in_frozen_to_headers_out{$W->{"uri_args_headers_in_frozen"}};
+ if (!$$headers_out_stored_hashref_ref
+ || !Data::Compare::Compare(\%headers_out,$$headers_out_stored_hashref_ref)) {
+ cluck "Non-matching generated 'headers_out' per 'uri_args_headers_in_frozen' key:\n"
+ .Dumper(\%headers_out,$$headers_out_stored_hashref_ref)
+ if $$headers_out_stored_hashref_ref;
+ # Build or possibly prevent such further warn dupes:
+ $$headers_out_stored_hashref_ref=\%headers_out;
+ }
+
+###print STDERR Dumper(\%uri_args_frozen_to_headers_in_keys,\%uri_args_headers_in_frozen_to_headers_out);