From b8c34b7761f9ad233e715291ca92559b2b617e5b Mon Sep 17 00:00:00 2001
From: short <>
Date: Thu, 15 Sep 2005 23:45:54 +0000
Subject: [PATCH] Provide "Last-Modified" HTTP header.  - Currently violating
 RFC as the "Vary" HTTP header is not yet implemented!

---
 Web.pm | 41 +++++++++++++++++++++++++++++++++++++----
 1 file changed, 37 insertions(+), 4 deletions(-)

diff --git a/Web.pm b/Web.pm
index 10bc1da..ab1646f 100644
--- a/Web.pm
+++ b/Web.pm
@@ -40,7 +40,7 @@ our @EXPORT=qw(
 		);
 our @ISA=qw(Tie::Handle Exporter);
 
-my %packages_used_hash;
+my %packages_used_hash;	# $packages_used_hash{$W->{"__PACKAGE__"}}{"_done"}=1;
 my %packages_used_array;
 
 BEGIN
@@ -114,6 +114,7 @@ use Apache2::Const qw(HTTP_MOVED_TEMPORARILY OK);
 use URI;
 use URI::QueryParam;
 use Cwd;
+require HTTP::Date;
 
 
 #our $W;
@@ -130,6 +131,7 @@ sub cleanup($)
 {
 my($apache_request)=@_;
 
+	$packages_used_hash{$W->{"__PACKAGE__"}}{"_done"}=1;
 	# Sanity protection.
 	$W=undef();
 	return OK;
@@ -810,10 +812,40 @@ sub no_cache($)
 {
 my($self)=@_;
 
-	header("Expires"=>"Mon, 26 Jul 1997 05:00:00 GMT");	# date in the past
-	header("Last-Modified"=>strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime()));	# always modified
-	header("Cache-Control"=>"no-cache, must-revalidate");	# HTTP/1.1
+	header("Expires"=>HTTP::Date::time2str(1000000000));	# date in the past
+	header("Last-Modified"=>HTTP::Date::time2str());	# always modified
+	header("Cache-Control"=>join(", ",
+			"no-cache",
+			"no-store",
+			"must-revalidate",
+			"max-age=0",
+			"pre-check=0",	# MSIE
+			"post-check=0",	# MSIE
+			));	# HTTP/1.1
 	header("Pragma"=>"no-cache");	# HTTP/1.0
+	header("Vary"=>"*");	# content may ba based on unpredictable sources
+}
+
+sub last_modified($)
+{
+my($self)=@_;
+
+	return if !$packages_used_hash{$W->{"__PACKAGE__"}}{"_done"};
+	my $mtime_newest;
+	for my $package_orig (@{$packages_used_array{$W->{"__PACKAGE__"}}}) {
+		local $_=$package_orig;
+		$_.=".pm";
+		s{::}{/}g;
+		my $path_abs_disk=path_abs_disk("/$_");
+		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;
+	# "Vary" header is REQUIRED in this case:
+	header("Last-Modified"=>HTTP::Date::time2str($mtime_newest));
+	return 1;
 }
 
 sub heading()
@@ -825,6 +857,7 @@ my($class)=@_;
 	header("Content-Style-Type"=>"text/css");
 	header("Content-Script-Type"=>"text/javascript");
 	do { header("Content-Language"=>$_) if $_; } for $W->{"language"};
+	$class->last_modified() if !$W->{"no_cache"};
 	$class->no_cache() if $W->{"no_cache"};
 
 	while (my($key,$val)=each(%{$W->{"headers"}})) {
-- 
1.8.3.1