package Apache::AxKit::Pipeline::XSP;

use strict;
use Apache::AxKit::Pipeline;
use Apache::AxKit::Language::XSP;
use Apache::Request;
use Apache::Constants;
use Apache::AxKit::Exception;
use Apache::AxKit::Cache;
use Fcntl;

use vars qw/@ISA/;

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

my $ramcache;

# Some notes on problems with logic sheets.
# OK, a Logic sheet is an XSP processor in the middle of a pipeline.
# Since it's in the middle, the say XSLT processors before its
# output may depend on some parameters.
# Only those parameters used by the XSLT processor need to be added
# to the cache key. However, there isn't a way at the moment to find them out.
# So we end up having to add ALL the stylesheet parameters if we're not the first
# processor after the provider.

# There are now THREE seperate cache mechanisms within XSP.
# The first is the in memory caching of the compiled XSP code.
# The second is the disk level caching of the parsed XSP code.
# The third is the xsp_dependencies cache for validation of the generated
# XML via an external downstream pipeline cache.


sub pipeline_init{
# Inorder to ensure that the version of the compiled XSP code an upstream cache
# talks to, we have to ensure the XSP is consistent a soon as the upstream
# pipeline is available, before any cache calls are made.
	
	my $self = shift;
	my $r = shift;
	my $stage = $self->stage();

	my $axkit_add_depends = \&AxKit::add_depends;
	local *AxKit::add_depends = sub { 
		$self->add_depends(@_); &$axkit_add_depends(@_) 
	};
	
	$self->upstream()->pipeline_init( $r );
	
    my $key = $self->SUPER::key( $r );	# Pipeline key.

    my $package = Apache::AxKit::Language::XSP::get_package_name($key);
	my $to_eval;

	if (exists($ramcache->{$key}) && $self->check_dependencies( $r ) && 
			defined &{"${package}::xml_generator"} ) {
		# cached
		AxKit::Debug(5, "XSP[$stage]: Script cached");
	} else {
	
		my $cache = Apache::AxKit::Cache->new( $r, $key );

		if( $self->SUPER::has_changed($cache->mtime()) || !( $to_eval = $cache->read() )) {
			AxKit::Debug(5, "XSP[$stage]: Requesting upstream XML");
			my $to_parse = $self->upstream()->get_dom( $r, 0 );

			AxKit::Debug(5, "XSP[$stage]: Compiling XSP to Perl");
			$to_eval = Apache::AxKit::Language::XSP->compile( $r, $key, $package, $to_parse);

			$cache->add_dependencies( $self->get_depends() );
			$cache->write( $to_eval );
		} else {
			AxKit::Debug(5, "XSP[$stage]: Loading precompiled XSP from cache");
		}			
				
		if ($to_eval) {
			eval {
				require Perl::Tidy;
				AxKit::Debug(5,"XSP[$stage] Running PerlTidy...");
				my $errors;
				my $res;
				Perl::Tidy::perltidy(
					source 		=> \$to_eval,
					destination => \$res,
					stderr 		=> \$errors,
					argv 		=> '-se -npro -f -nsyn -pt=2 -sbt=2 -csc -csce=2 -vt=1 -lp -cab=3 -iob'
				);
				if ($errors) {
					AxKit::Debug(1,"PerlTidy warnings: $errors");
				} else {
					AxKit::Debug(5,"PerlTidy successful");
				}
				$to_eval = $res;
			} if $AxKit::Cfg->DebugTidy;

			AxKit::Debug(1,"AxDebugTidy unavailable for Perl code: $@") if $@;

			if ($AxKit::Cfg->TraceIntermediate) {
				my $interm_prefix = $r->uri;
				$interm_prefix =~ s{/}{|}g;
				$interm_prefix =~ s/[^0-9a-zA-Z.,_|-]/_/g;
				$interm_prefix = $AxKit::Cfg->TraceIntermediate.'/'.$interm_prefix;
				my $fh = Apache->gensym();
				if (open($fh, '>'.$interm_prefix.'.XSP')) {
					print($fh $to_eval);
				} else {
					AxKit::Debug(1,"could not open $interm_prefix.XSP for writing: $!");
				}
			}

			undef &{"${package}::xml_generator"};
			AxKit::Debug(5, "XSP[$stage]: Recompiling script");
			AxKit::Debug(10, $to_eval);
			eval $to_eval;
			if ($@) {
				my $line = 1;
				$to_eval =~ s/\n/"\n".++$line." "/eg;
				warn("Script:\n1 $to_eval\n");
				throw Apache::AxKit::Exception::Error(
					-text => "Compilation failed: $@"
				);
			}

			$ramcache->{$key}{mtime} = time();
			$ramcache->{$key}{depends} = [ $self->get_depends() ];

			AxKit::Debug(5, "XSP[$stage]: Compilation finished");
		}
	}
}


sub key{
	my ($self, $r) = @_;
    my $key = $self->SUPER::key( $r );	# pipeline key.
	my $package = Apache::AxKit::Language::XSP::get_package_name($key);
  	my $cgi = Apache::Request->instance($r);
    my $key_extra = $package->cache_params($r, $cgi);

	# at the first stage in the pipeline, only the provider key should
	# really be relevent. Later on, we don't know which parameters have been
	# used by a stylesheet, so we have to take them ALL into account.
	# Suggestions for a better alternative are welcome.
	
	if($self->stage() != 1) {
		$key_extra .= $self->get_params($r);
	}
	return $key.$key_extra;
}

sub has_changed{
	my $self = shift;
	my ($mtime) = @_;
	
 	my $r = AxKit::Apache->request();
 
    my $key = $self->SUPER::key( $r );	# pipeline key.
	my $package = Apache::AxKit::Language::XSP::get_package_name($key);
				   
	if(! $package->has_changed( $mtime, $r, $self->key($r)."xsp_dependencies" )) {
   		return $self->SUPER::has_changed( $mtime );
 	}
	# By default, we will always assume XSP isn't cacheable, unless
	# the the cache validation routines have been defined.
	return 1;
}	
	
	
sub new{
	my $class = shift;
	my $self = $class->SUPER::new(@_);
	$self->{'depends'} = {};
	return $self;
}

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

sub check_dependencies {
    my ($self, $r ) = @_;
    my $stage = $self->stage();
	my $key = $self->SUPER::key( $r ); # Pipeline key.
    AxKit::Debug(2, "XSP[$stage]: Checking script dependencies");
    if ( $self->SUPER::has_changed( $ramcache->{$key}->{mtime}  ) ) {
        AxKit::Debug(3, "XSP[$stage]: Pipeline newer than compiled script");
        return 0;
    }
    else {
		for my $dependency ( @{$ramcache->{$key}->{depends}} ) {
			my ($dep_type) = $dependency =~ s|^\{(\w+)\}||;
			
			AxKit::Debug(3, "XSP[$stage]: Checking dependency: $dependency of type $dep_type");
			my $dep = ($dep_type eq "style") ?
				Apache::AxKit::Provider->new_style_provider($r, key => $dependency) :
				Apache::AxKit::Provider->new($r, key => $dependency);
				
			if ( $dep->has_changed( $ramcache->{$key}->{mtime} ) ) {
				AxKit::Debug(4, "XSP[$stage]: $dependency newer");
				return 0;
			}
		}
    }
    return 1;
}



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

    my $key = $self->SUPER::key( $r );	# Pipeline key.

    my $package = Apache::AxKit::Language::XSP::get_package_name($key);

    no strict 'refs';
    # make sure we use inheritance to get this
    my $cv = $package->can('handler');

    my $cgi = Apache::Request->instance($r);

	# By default XSP output isn't cached.
	# XSP's should define to subs $package->has_changed( $mtime, $r, $key)
	# and $package->save_dependencies( $r, $key )

	$r->no_cache(1);

	AxKit::Debug(5, "XSP[$stage]: Generating XML from XSP");
    my $dom = XML::LibXML::Document->createDocument("1.0", "UTF-8");
    my $rc = eval { $package->$cv($r, $cgi, $dom); };
 
    if ($@) {
        die $@ if (ref($@));
        throw Apache::AxKit::Exception::Error(
            -text => "Execution failed: $@"
        );
    }	

	if($package->enable_cache( $r, $self->key($r)."xsp_dependencies")) {
		AxKit::Debug(5, "XSP[$stage]: XSP cachable.");
		$r->no_cache(0);
	}			
	
	if( ! ($rc == 200 || $rc == OK) ) {
		$r->status($rc);
	}
	
    return $dom;
}


sub enable_dynamic_styles{ 1 };

1;

	
