Provide "Last-Modified" HTTP header.

 - Currently violating RFC as the "Vary" HTTP header is not yet implemented!

diff --git a/Web.pm b/Web.pm
index 10bc1da..ab1646f 100644 (file)
--- 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"}})) {