package Apache::AxKit::Pipeline::Cache;

use strict;
use vars qw/@ISA $VERSION %DEPENDS/;
use Apache;
use AxKit;
use Apache::AxKit::Pipeline;
use Apache::AxKit::Cache;
use Apache::Constants;
use File::Basename qw(dirname);

@ISA = 'Apache::AxKit::Pipeline';

$VERSION = 1.0; # this fixes a CPAN.pm bug. Bah!

sub new{
	my $class = shift;
	my $self = $class->SUPER::new(@_);
	$self->{'_cache'} = undef;
	$self->{'cached'} = 0;
	$self->{'depends'} = {};
	return $self;
}


# remember to change get_strref as well!

sub get_dom {
    my $self = shift;
    my ($r) = @_;

	my $stage = $self->stage();

	# chain in a add_depends handler
	# which will call the underlying one.
	# This way we see everything loaded in the pipeline above us, without
	# changing any interfaces.

	my $axkit_add_depends = \&AxKit::add_depends;
	local *AxKit::add_depends = sub { $self->add_depends(@_); &$axkit_add_depends(@_) };

	# removed media/style from the cache key
	# since $self->key() is now the pipeline key
	# which is the result of the media/style choice.

	# No .gzip bit here, since we'll always be wanting a dom....we are not last in chain.

    my $cache = Apache::AxKit::Cache->new(
    	$r, $self->key( $r ) . ($r->path_info() || ''));

	# Add headers to $r if set to enable debugging of the cache.
	my $debug = $r->dir_config('AxCacheDebugHeaders');

	$self->{'_cache'} = $cache;

	my $xml_doc;
	my $str;

	# if provider is newer or dependancies not upto date
	# then call upstream, cache response, and save dependancies.
	if( $cache->no_cache() || $r->no_cache() || $r->method() eq 'POST' || $r->status() != 200) {
		AxKit::Debug(4, "Cache[$stage]: Cache disabled, requesting upstream XML.");		
		$r->no_cache(1);
		$xml_doc = $self->upstream()->get_dom( $r );
		$r->header_out('X-AxKit-Cache-'.$self->stage(), 'disabled') if $debug;
	} elsif( !$self->upstream()->has_changed( $cache->mtime() ) && ( $str = $cache->read() ) ) {	
		AxKit::Debug(4, "Cache[$stage]: Successful cache read.");
		# no fast-deliver since we're getting a dom and thus cannot be last in chain
		$self->cached(1);
		$r->content_type( $cache->get_type() );
		my $parser = XML::LibXML->new();
	    $parser->expand_entities(1);
	    Apache::AxKit::LibXMLSupport->reset;
		$xml_doc = $parser->parse_string( $str ) or throw Apache::AxKit::Exception::Error(
			-text => "Cache[$stage]: Cache returned empty xml document"
		);
		$r->header_out('X-AxKit-Cache-'.$self->stage(), 'hit') if $debug;
	} else {
		AxKit::Debug(4, "Cache[$stage]: Cache miss, requesting upstream XML.");
		$xml_doc = $self->upstream()->get_dom($r);	

		if($r->status() == 200 && ! $r->no_cache() )  {

			AxKit::Debug(4, "Cache[$stage]: Cache doing write and pass-through.");
				
			$cache->set_type( $r->content_type() );
			$cache->add_dependencies( $self->get_depends() );
			$cache->write( $xml_doc->toString() );
			
			$r->header_out('X-AxKit-Cache-'.$self->stage(), 'miss+write') if $debug;
			# No fast deliver since can't be last in chain with get_dom()
		
		} else {
			$r->header_out('X-AxKit-Cache-'.$self->stage(), 'miss+disabled') if $debug;	
			AxKit::Debug(4, "Cache[$stage]: Cache disabled due to status code or no_cache.");
		}
	}

    return $xml_doc;
}



sub get_strref{
    my $self = shift;
    my ( $r ) = @_;

	# chain in a add_depends handler
	# which will call the underlying one.
	# This way we see everything loaded in the pipeline above us, without
	# changing any interfaces.

	my $axkit_add_depends = \&AxKit::add_depends;
	local *AxKit::add_depends = sub { 
		$self->add_depends(@_); &$axkit_add_depends(@_) };

	my $debug = $r->dir_config('AxCacheDebugHeaders');
	
	# removed media/style from the cache key
	# since $self->key() is not the pipeline key
	# which is the result of the media/style choice.

    my $cache = Apache::AxKit::Cache->new( $r, $self->key( $r ) . ($r->path_info() || '') );

	$self->{'_cache'} = $cache;
	
	my $str_ref;
	my $str;
	my $stage = $self->stage();

	# if provider is newer or dependancies not upto date
	# then call upstream, cache response, and save dependancies.
	if( $cache->no_cache() || $r->no_cache() || $r->method() eq 'POST' || $r->status() != 200) {
		AxKit::Debug(4, "Cache[$stage]: Cache disabled, requesting upstream XML");
		$r->no_cache(1);
		$str_ref = $self->upstream()->get_strref( $r );
		$r->header_out('X-AxKit-Cache-'.$self->stage(), 'disabled') if $debug;		
	} elsif( !$self->upstream()->has_changed( $cache->mtime() )  && 
				$cache->exists() && ( $str = $cache->read( ) ) ) {

		AxKit::Debug(4, "Cache[$stage]: Successful cache read.");
		$r->content_type( $cache->get_type() );
		$self->cached(1);
		$str_ref = \$str;
		$r->header_out('X-AxKit-Cache-'.$self->stage(), 'hit') if $debug;

	} else {
		AxKit::Debug(4, "Cache[$stage]: Cache miss, requesting upstream XML.");
		$self->cached(0);		
		$str_ref = $self->upstream()->get_strref( $r );
		
		if($r->status() == 200 && ! $r->no_cache() ) {

			AxKit::Debug(4, "Cache[$stage]: Cache doing write and pass-through.");
				
			$cache->set_type( $r->content_type() );
			$cache->add_dependencies( $self->get_depends() );
			$cache->write( $str_ref );
			$r->header_out('X-AxKit-Cache-'.$self->stage(), 'miss+write') if $debug;		

		} else {
			AxKit::Debug(4, "Cache[$stage]: Cache disabled due to status code or no_cache.");
			$r->header_out('X-AxKit-Cache-'.$self->stage(), 'miss+disabled') if $debug;		
		}
	}
    return $str_ref;	
}

sub send{
    my ($self, $r) = @_;

	my $bytes;
	# See A::A::Pipeline.pm for what this is about.
	do {
#		local(*STDOUT);

		# chain in a add_depends handler
		# which will call the underlying one.
		# This way we see everything loaded in the pipeline above us, without
		# changing any interfaces

		my $axkit_add_depends = \&AxKit::add_depends;
		local *AxKit::add_depends = sub { 
			$self->add_depends(@_); &$axkit_add_depends(@_) };

		# removed media/style from the cache key
		# since $self->key() is not the pipeline key
		# which is the result of the media/style choice.

		my $debug = $r->dir_config('AxCacheDebugHeaders');

    	my $cache = Apache::AxKit::Cache->new(
    		$r, $self->key( $r ) . ($AxKit::Cfg->GzipOutput ? '.gzip' : '') . ($r->path_info() || ''), 
    	);

		$self->{'_cache'} = $cache;
	
		my $str;
		my $stage = $self->stage();

	# if provider is newer or dependancies not upto date
	# then call upstream, cache response, and save dependancies.
		if( $cache->no_cache() || $r->no_cache() || $r->method() eq 'POST' || $r->status() != 200) {
			AxKit::Debug(4, "Cache[$stage]: Cache disabled, requesting upstream XML");
			$r->no_cache(1);
			$bytes = $self->upstream()->get_bytes_ref( $r );
			$r->header_out('X-AxKit-Cache', 'disabled') if $debug;

		} elsif( !$self->upstream()->has_changed( $cache->mtime() )  && 
					$cache->exists() && ( $cache->check_dependencies( ) ) ) {
			AxKit::Debug(4, "Cache[$stage] Successful cache read, attempting fast-deliver...");
			$r->header_out('X-AxKit-Cache', 'hit') if $debug;
			$cache->deliver( $r );
			return DECLINED;
		} else {
			AxKit::Debug(4, "Cache[$stage]: Cache miss, requesting upstream XML.");
			$self->cached(0);		
			$bytes = $self->upstream()->get_bytes_ref( $r );
		
			if($r->status() == 200 && ! $r->no_cache() ) {

				AxKit::Debug(4, "Cache[$stage]: Cache doing write and pass-through.");
				$cache->set_type( $r->content_type() );
				$cache->add_dependencies( $self->get_depends() );
				$r->header_out('X-AxKit-Cache', 'miss+write') if $debug;
				if($cache->write( $bytes )) {
					AxKit::Debug(4, "Cache[$stage]: Cache doing write and fast-deliver.");
					# We're last in chain, and there are no output transformers. 
					# do a fast delivery.
					$cache->deliver( $r );
					return DECLINED;
				}
			} else {
				$r->header_out('X-AxKit-Cache', 'miss+disabled') if $debug;
				AxKit::Debug(4, "Cache[$stage]: Cache disabled due to status code or no_cache.");
			}
		}
	};
    if (ref($r) eq 'AxKit::Apache') {
        bless $r, 'Apache';
    }

    if( $AxKit::Cfg->DoGzip() ) {
		AxKit::Debug(4, "Gzipping output.");    
    	${$bytes} = Compress::Zlib::memGzip( ${$bytes} );
    }

    AxKit::Debug(4, "delivering to browser");
	$r->header_out('Content-Length' => length(${$bytes}));
	$r->send_http_header();
	return DONE if $r->method eq 'HEAD';
	$r->print(${$bytes});
   	return OK;
	
	# do the deliver thing.	
}

sub cached{
	my $self = shift;
	$self->{'cached'} = $_[0] if @_;
	return $self-{'cached'};
}

sub cache_required{
	# Don't get the pipeline to add a cache module
	# since one already exists in the pipeline
	return 0;
}

sub add_depends{
	shift->{'depends'}->{ shift() }++;
}

sub get_depends{
	return keys %{shift()->{'depends'}};
}

sub pipeline_init{
	my $self = shift;
	my $r = shift;
	my $axkit_add_depends = \&AxKit::add_depends;
	local *AxKit::add_depends = sub { 
		$self->add_depends(@_); &$axkit_add_depends(@_) 
	};
	return $self->upstream()->pipeline_init($r);
}

sub key{
	my ($self, $r) = @_;
	return $self->SUPER::key( $r ).$r->notes('axkit_cache_extra');
}


1;
