#!/usr/bin/perl

#
# check store for stale entries and duplicates
#

use strict;
use File::Find;
use Date::Parse;
$| = 1;

my $cache_path	= '/usr/local/apache/htdocs/cache/store';
my $lynx        = '/usr/bin/lynx';
my $debug = shift;
my @files;

# keep lynx happy
$ENV{TERM} = 'vt100';

chdir "$cache_path/..";

# delete stale entries (and gather files in @files)
find(\&check, $cache_path);

# find duplicates
foreach my $file_1 (@files) {
	next if $file_1 =~ /\.downloading$/;
	foreach my $file_2 (@files) {
		next if $file_2 =~ /\.downloading$/;
		next if $file_1 eq $file_2;
		next if (stat $file_1)[1] == (stat $file_2)[1];	# same inode

		next unless -s $file_1 == -s $file_2;
		my $diff = `diff $file_1 $file_2`;
		next if $diff;

		# files are the same
		local *FH;
		$debug && print STDERR "found duplicate :\n  $file_1\n  $file_2\n\n";
		
		# flag one we are going to delete as being downloading
		open(FH, ">$file_2.downloading");
		close FH;

		# delete it
		unlink($file_2) || die "couldn't delete $file_2 : $!\n";

		# and link to first file
		link($file_1, $file_2) || die "couldn't link $file_1 --> $file_2 : $!\n";

		# remove the downloading flag
		unlink "$file_2.downloading";

		# log it
		open(FH, ">>$cache_path/../log");
		print FH '[' . scalar(localtime) . "] linking $file_1 --> $file_2\n";
		close FH;

	}
}

sub check {

	my $file = "$File::Find::dir/$_";
	return if -d $file;

	if ($file =~ /\?/) {
		unlink $file;
		return;
	}

	push @files, $file;

	my $url;

	if ($_[1] eq 'tman') {
		$url = shift;
		$url =~ s#^http://##i;
		$file = $_[1];
	} else {
		$url = $file;
		$url =~ s/^$cache_path//;
		$url =~ s#^/##;
	}
	my($host) = $url =~ m#^([^/]+)#;
	my($port) = $host =~ s/:(\d+)$//;
	$port ||= 80;
	$url = "http://$url";
	$url =~ s/ /%20/g;

	if (!-s $file) {
		$debug && print STDERR "deleting empty file $file\n";
		unlink $file;
		return;
	}

	my $head = `$lynx -head -dump '$url' 2>&1`;
	$head =~ s/[\r\n\s]+$/\n/;
	$debug && print STDERR "\n\n$url\n$file\n----\n$head----\n";

	my($last_mod) = $head =~ /[\n\r]+Last-Modified: ([^\n\r]+)/i;
	if ($last_mod eq '') {
		if ($head =~ m#^HTTP/\d+\.\d+ (40[34])#) {
			my $code = $1;
			$debug && print STDERR "http error $code - deleting $file\n";
			$url =~ s#^http://##;
			logme("remove_$code $url");
			unlink $file;
		} elsif ($head =~ m#^HTTP/\d+\.\d+ 401#) {
			$debug && print STDERR "http error 401 access denied.  skipping $file\n";
		} else {
			my($redirect) = $head =~ /[\n\r]+Location: ([^\n\r]+)/i;
			if($redirect ne '') {
				$debug && print STDERR "Redirection to $redirect\n";
				check($redirect, 'tman', $file);
			} else {
				if ($url eq 'http://msdn.microsoft.com/404/default.asp') {
					unlink $file;
					return;
				}
				print "check error - probably no last-modified header\n$url\n$file\n\n$head\n\n";
			}
		}
	} else {
		$debug && print STDERR "Last-Modified: $last_mod\n";
		return unless -e $file;
		my $local = (stat $file)[9];
		my $remote = str2time($last_mod);
		my $diff = $remote - $local;
		return if $remote eq '';
		$debug && print STDERR "local: $local\nremote: $remote\ndiff: $diff\n";
		return if $diff == 0;
		$debug && print STDERR "local store and source file differ - deleting local file\n";
		unlink $file;
		$url =~ s#^http://##;
		logme("remove_stale $url");
	}

}

sub logme($) {
	my $msg = shift;
	local *FH;
	open(FH, ">>$cache_path/../log");
	print FH '[' . scalar(localtime) . "] $msg\n";
	close FH;
} 


